home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / prg_basi / qbsvga.zip / QBSVGA.BAS < prev    next >
BASIC Source File  |  1996-08-29  |  68KB  |  2,515 lines
  1. DEFSNG A-Z
  2. '
  3. '  Subroutine BSCREEN emulates the function of QB's SCREEN statement.
  4. ' It uses subroutine FINDVESA to find a video mode supported by a VESA
  5. ' bios that corresponds to a "QB-type" mode specified by MODE.  The
  6. ' resolutions for each supported MODE integer are given below.
  7. '
  8. '   MODE = 14:   640 x  480 x 256
  9. '   MODE = 15:   800 x  600 x  16
  10. '   MODE = 16:   800 x  600 x 256
  11. '   MODE = 17:  1024 x  768 x  16
  12. '   MODE = 18:  1024 x  768 x 256
  13. '   MODE = 19:  1200 x 1024 x  16
  14. '   MODE = 20:  1200 x 1024 x 256
  15. '   MODE = 21:  1600 x 1200 x  16
  16. '   MODE = 22:  1600 x 1200 x 256
  17. '   MODE = 23:   132 x   25 x  16 (text)
  18. '   MODE = 24:   132 x   43 x  16 (text)
  19. '   MODE = 25:   132 x   50 x  16 (text)
  20. '
  21. ' These routines should not be used with modes not specified here.  Mode
  22. ' 0 is an allowable input; it corresponds to QB's SCREEN 0 and gets
  23. ' translated here to bios mode 3.  (Except for more colors, I'm not aware
  24. ' of any higher modes, anyway, and why would you want to use these
  25. ' routines with the lower modes?  QB's SCREEN statement will do that.)  If
  26. ' a mode with the desired resolution and colors cannot be found, a mode
  27. ' will still be selected if one can be found with the desired resolution
  28. ' and *more* colors than necessary.
  29. '
  30. '  The first four inputs are just as would be used with QB's SCREEN
  31. ' statement except that CL is the default color to print with, not some
  32. ' switch that determines whether color is displayed at all.  Unlike the
  33. ' SCREEN statement, all parameters much be specified in the CALL.  If the
  34. ' input video mode is the one that is already in effect, BSCREEN can be
  35. ' used to simply change default colors or displayed/active pages.  (You
  36. ' might want to use subroutine BCOLOR for the former purpose.)  BSCREEN
  37. ' should be called before any of the other routines are called.
  38. '
  39. SUB BSCREEN(MODE,CL,APAGE,VPAGE)
  40. DIM CMODE AS INTEGER
  41. '
  42. '  Store active page and default color in global variables.  (Alias VPAGE
  43. ' with VP and make sure its value is valid.)
  44. '
  45. ACPAGE=APAGE : IF ACPAGE<0 THEN ACPAGE=0
  46. DEFLTC=CL : IF DEFLTC<=0 THEN DEFLTC=7
  47. VP=VPAGE : IF VP<0 THEN VP=0
  48. '
  49. '  Get current video mode.  If it is same as one being set, no mode change
  50. ' is made.  The routine is just being used to change default colors
  51. ' (subroutine BCOLOR is simpler to use for that purpose) or pages.  (The
  52. ' value of CMODE may get changed after VESA-awareness is determined.)
  53. '
  54. INREGS.AX=&HF00
  55. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  56. CMODE=OUTREGS.AX AND &HFF
  57. '
  58. '  Set visible page.
  59. '
  60. INREGS.AX=CINT(VP)+1280
  61. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  62. '
  63. '  Make correlation between "QB-type" modes and resolution of bios mode to
  64. ' be searched for.  (Set default mode data in case invalid mode was input.)
  65. '
  66. HR=800 : VR=600 : NC=16
  67. IF MODE=14 THEN HR=640 : VR=480
  68. IF MODE=15 OR MODE=16 THEN HR=800 : VR= 600
  69. IF MODE=17 OR MODE=18 THEN HR=1024 : VR=768
  70. IF MODE=19 OR MODE=20 THEN HR=1280 : VR=1024
  71. IF MODE=21 OR MODE=22 THEN HR=1600 : VR=1200
  72. IF MODE=23 THEN VR=25
  73. IF MODE=24 THEN VR=43
  74. IF MODE=25 THEN VR=50
  75. IF MODE=0 OR MODE=15 OR MODE=17 OR MODE=19 OR MODE=21 OR MODE>22 THEN NC=16
  76. IF MODE=14 OR MODE=16 OR MODE=18 OR MODE=20 OR MODE=22 THEN NC=256
  77. IF MODE=23 OR MODE=24 OR MODE=25 THEN HR=132
  78. '
  79. '  Define global resolution limits (zero-based) and viewport defaults.
  80. '
  81. HMAX=HR-1 : VMAX=VR-1 : VXL=0 : VYL=0 : VXR=HMAX : VYR=VMAX
  82. '
  83. '  Set VCOL to a negative number so other routines can tell that BVIEW
  84. ' wasn't called yet.
  85. '
  86. VCOL=-1
  87. IF MODE<>0 THEN
  88. '
  89. '  SCREEN is not being reset to text mode.  Find VESA mode with desired
  90. ' resolution.  If FINDVESA can't find a requisite VESA mode, whether
  91. ' because system isn't VESA-aware or other reasons, BMODE is returned as
  92. ' -1.  (If system is detected as VESA aware, an "error code" of 0 is
  93. ' defined via VESSUP variable.  If VESA cannot be detected, VESSUP is set
  94. ' to unity.)  Before using FINDVESA, however, look for overriding bios
  95. ' mode definition via DOS environment variable.  (This environment
  96. ' is SET with the syntax "MODE##=bios-mode", where ## is the two-digit
  97. ' QB-type mode integer that corresponds to bios-mode.)
  98. '
  99. QBMODE$="MODE"+LTRIM$(RTRIM$(STR$(MODE)))
  100. EMODE$=MID$(LTRIM$(ENVIRON$(QBMODE$)),1,80)
  101. BMODE=VAL("&H0"+EMODE$)
  102. '
  103. '  In case FINDVESA isn't going to be used to find a VESA video mode or
  104. ' it *is* going to be used and in case it fails, set default bit planes
  105. ' per pixel and bits per pixel parameters.
  106. '
  107. BITPLANES=1 : BITSPIXEL=8
  108. IF BMODE=0 THEN
  109. '
  110. '  "MODE##" environment variable didn't exist for input QB-type mode.
  111. '
  112. CALL FINDVESA(BMODE,HR,VR,NC)
  113. '
  114. '  Except for text mode 3, there are no bios modes less than 4 that are
  115. ' of concern here.  (There aren't likely any below 13h of any importance.
  116. ' I'm just taking into account "wierd" video adapters, such as mine, which
  117. ' will do a hex mode B.)
  118. '
  119. IF BMODE>=4 THEN
  120. '
  121. '  VESA mode was found, hence, system is VESA-aware.  Redetermine current
  122. ' video mode.
  123. '
  124. INREGS.AX=&H4F03
  125. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  126. CMODE=OUTREGS.BX
  127. IF CMODE<>BMODE THEN
  128. '
  129. '  VESA mode was found and it is different from current mode; change video
  130. ' mode.
  131. '
  132. INREGS.AX=&H4F02
  133. INREGS.BX=BMODE
  134. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  135. IF MODE<23 THEN
  136. '
  137. '  Initialize mouse if driver is installed via interrupt 33h.
  138. '
  139. IF QRYMOUSE=-1 THEN CALL MOUSINIT
  140. END IF
  141. END IF
  142. ELSE
  143. '
  144. '  VESA mode couldn't be found.  Assume "OEM SVGA" and ask user for
  145. ' hexadecimal mode integer that corresponds to desired video mode.  Set
  146. ' VESSUP according to value of input bios mode.  (Put screen in standard
  147. ' QB text mode so prompt can be seen in case it was already in some
  148. ' QB-unreadable graphics screen.)
  149. '
  150. INREGS.AX=3
  151. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  152. SCREEN 0
  153. RES$=LTRIM$(RTRIM$(STR$(HR)))+" x "+LTRIM$(RTRIM$(STR$(VR)))+" x "
  154. RES$=RES$+LTRIM$(RTRIM$(STR$(NC)))
  155. PRINT
  156. PRINT "  Couldn't find VESA mode giving resolution ";RES$;".  What"
  157. PRINT "hexadecimal bios mode integer gives you this resolution?  (Press ENTER"
  158. PRINT "to stop.)"
  159. LINE INPUT M$
  160. M$=RTRIM$(LTRIM$(M$))
  161. IF M$="" THEN STOP
  162. '
  163. '  Video mode is changed regardless of its present state when mode had to
  164. ' be prompted for.  (Even if the above text-mode change hadn't occurred,
  165. ' the prompt for the mode needs to be cleared.)
  166. '
  167. VESSUP=1
  168. INREGS.AX=VAL("&H"+M$)
  169. '
  170. '  Use VESA call to set video mode if it is 100h or above.  Otherwise,
  171. ' use standard bios call.
  172. '
  173. IF INREGS.AX>255 THEN
  174. VESSUP=0
  175. INREGS.BX=INREGS.AX
  176. INREGS.AX=&H4F02
  177. END IF
  178. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  179. IF MODE<23 THEN
  180. '
  181. '  Initialize mouse if driver is installed via interrupt 33h.
  182. '
  183. IF QRYMOUSE=-1 THEN CALL MOUSINIT
  184. END IF
  185. END IF
  186. ELSE
  187. '
  188. '  "MODE##" environment variable exists for desired mode.  Set VESSUP
  189. ' according to value of bios mode.
  190. '
  191. VESSUP=1 : IF BMODE>255 THEN VESSUP=0
  192. '
  193. '  Re-acquire and test current video mode before changing it.
  194. '
  195. IF VESSUP=1 THEN
  196. INREGS.AX=&HF00
  197. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  198. CMODE=OUTREGS.AX AND &HFF
  199. INREGS.AX=BMODE
  200. ELSE
  201. INREGS.AX=&H4F03
  202. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  203. CMODE=OUTREGS.BX
  204. INREGS.AX=&H4F02
  205. INREGS.BX=BMODE
  206. END IF
  207. IF CMODE<>BMODE THEN
  208. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  209. IF MODE<23 THEN
  210. '
  211. '  Initialize mouse if driver is installed via interrupt 33h.
  212. '
  213. IF QRYMOUSE=-1 THEN CALL MOUSINIT
  214. END IF
  215. END IF
  216. END IF
  217. '
  218. '  Global variable BVCBL is normally 0.  BVIEW sets it to 1 just before
  219. ' calling BLINE to draw a border around the viewport.  (BLINE uses this
  220. ' variable to know not to enforce viewport constraints when BVIEW tries to
  221. ' draw a box just outside of the viewport.  (BVIEW resets it to unity when
  222. ' it's finished.)  Define fictitious values for global mouse position
  223. ' variables.
  224. '
  225. BVCBL=0
  226. ELSE
  227. '
  228. '  SCREEN 0 is being emulated.  Use what should be a standard text mode
  229. ' for any SVGA system.  (This mode is also set regardless of whether or
  230. ' not the video state is already there.)
  231. '
  232. INREGS.AX=3
  233. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  234. '
  235. '  Just to be safe, make sure QB knows what screen mode it's in.  (The
  236. ' above call to interrupt 10 could probably be skipped, but QB's SCREEN 0
  237. ' by itself doesn't necessarily leave you in the text mode you want when
  238. ' the screen isn't initially in a mode that QB recognizes.)
  239. '
  240. SCREEN 0
  241. END IF
  242. END SUB
  243. '
  244. '  This subroutine returns the VESA bios MODE integer (decimal) that has
  245. ' resolution HR x VR x NC, as input via the parameter list.  If no such
  246. ' mode can be found, MODE is returned as -1.  (If it finds a mode with
  247. ' the desired horizontal HR and vertical VR resolution but with more than
  248. ' NC colors, the mode is considered valid and is returned in MODE.  (It
  249. ' will first try to find a mode with NC colors.))
  250. '
  251. '  To qualify as a valid, the mode must be supported by both hardware and
  252. ' bios.  (FINDVESA is usually called by BSCREEN.  There is not much reason
  253. ' to call it directly.)
  254. '
  255. SUB FINDVESA(MODE,HR,VR,NC)
  256. DIM VESA(1 TO 64) AS LONG,BYTE AS LONG,MD(1 TO 257) AS INTEGER,COLORS(1 TO 256)
  257. DIM PLANES(1 TO 256)
  258. SM=VARSEG(VESA(1)) : OS=VARPTR(VESA(1))
  259. '
  260. '  Set VESSUP to unity in case VESA bios cannot be detected.
  261. '
  262. VESSUP=1
  263. '
  264. '  Confirm VESA support and get pointer to list of supported VESA modes.
  265. '
  266. INREGS.AX=&H4F00
  267. INREGS.ES=CINT(SM)
  268. INREGS.DI=CINT(OS)
  269. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  270. DEF SEG=SM
  271. T$=CHR$(PEEK(OS))+CHR$(PEEK(OS+1))+CHR$(PEEK(OS+2))+CHR$(PEEK(OS+3))
  272. IF T$<>"VESA" THEN GOTO NOSUP
  273. '
  274. '  VESA = VESA bios version number.
  275. '
  276. VESAFRC=PEEK(OS+4)
  277. FIXFRC:
  278. VESAFRC=VESAFRC/10
  279. IF VESAFRC>=1 THEN GOTO FIXFRC
  280. VESA=PEEK(OS+5)+VESAFRC
  281. PSM=PEEK(OS+16)+256*PEEK(OS+17) : POF=PEEK(OS+14)+256*PEEK(OS+15)
  282. '
  283. '  Look for video mode that supports desired resolution.
  284. '
  285. '  NMODES counts number of modes (possibly with different colors) with
  286. ' desired resolution.
  287. '
  288. NMODES=1
  289. NEWMODE:
  290. DEF SEG=PSM
  291. MD(NMODES)=PEEK(POF)+256*PEEK(POF+1) : POF=POF+2
  292. IF MD(NMODES)=-1 THEN GOTO NOSUP
  293. INREGS.AX=&H4F01
  294. INREGS.CX=MD(NMODES)
  295. INREGS.ES=CINT(SM)
  296. INREGS.DI=CINT(OS)
  297. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  298. DEF SEG=SM
  299. '
  300. '  First byte at segment SM stores "support information" about mode under
  301. ' analysis.
  302. '
  303. BYTE=CLNG(PEEK(OS)+256*PEEK(OS+1))
  304. B$=LTRIM$(RTRIM$(BIN$(BYTE)))
  305. '
  306. '  Bits 0 and 2 indicate support (or lack of it) in hardware and BIOS.
  307. '
  308. HARD$=MID$(B$,16,1)
  309. BIOS$=MID$(B$,14,1)
  310. IF HARD$="0" OR BIOS$="0" THEN GOTO NEWMODE
  311. '
  312. '  Bit 4 indicates graphics or text mode.
  313. '
  314. GMSW$=MID$(B$,12,1)
  315. '
  316. '  Bit 1 indicates the presence of extended information.  If no extended
  317. ' information is available for this mode, it cannot be determined that
  318. ' it supports the required HR x VR resolution.
  319. '
  320. EXTINF$=MID$(B$,15,1)
  321. IF EXTINF$="0" THEN GOTO NEWMODE
  322. '
  323. '  Character sizes are needed to correct stored resolution data for some
  324. ' VESA bioses.
  325. '
  326. HS=PEEK(OS+22) : VS=PEEK(OS+23)
  327. HRM=PEEK(OS+18)+256*PEEK(OS+19) : VRM=PEEK(OS+20)+256*PEEK(OS+21)
  328. IF VESA<1.2 THEN
  329. IF GMSW$="0" THEN HRM=HRM/HS : VRM=VRM/VS
  330. IF (MD(NMODES)>=0 AND MD(NMODES)<=6) OR MD(NMODES)=13 THEN VRM=VRM/2
  331. IF MD(NMODES)=14 OR MD(NMODES)=19 THEN VRM=VRM/2
  332. END IF
  333. IF HR<>HRM OR VR<>VRM THEN GOTO NEWMODE
  334. COLORS(NMODES)=2!^CSNG(PEEK(OS+25))
  335. '
  336. '  Get number of bit planes.  (Subroutines BGET AND BPUT need it.  They
  337. ' also need the number of bits per pixel.  This is actually what was just
  338. ' reported by the VESA bios, above.  It will be reobtained from the COLORS
  339. ' parameter later.)
  340. '
  341. PLANES(NMODES)=PEEK(OS+24)
  342. '
  343. '  Get all modes with required resolution, regardless of color.  (Later
  344. ' on the one with NC colors, if it exists, will be chosen.  (But the
  345. ' possibility that the one with the right number of colors will be found
  346. ' first is taken into account.))
  347. '
  348. IF COLORS(NMODES)=NC THEN GOTO RETMODE
  349. IF NMODES<256 THEN NMODES=NMODES+1 : GOTO NEWMODE
  350. RETMODE:
  351. '
  352. '  Since VESA was detected, store corresponding error code.
  353. '
  354. VESSUP=0
  355. FOR I=1 TO NMODES
  356. K=I
  357. IF COLORS(I)=NC THEN BITSPIXEL=INT(LOG(COLORS(I))/LOG(2)+.001)
  358. IF COLORS(I)=NC THEN MODE=CSNG(MD(I)) : BITPLANES=PLANES(I) : GOTO QUIT
  359. NEXT I
  360. FOR I=1 TO NMODES
  361. K=I
  362. IF COLORS(I)>NC THEN BITSPIXEL=INT(LOG(COLORS(I))/LOG(2)+.001)
  363. IF COLORS(I)>NC THEN MODE=CSNG(MD(I)) : BITPLANES=PLANES(I) : GOTO QUIT
  364. NEXT I
  365. NOSUP:
  366. '
  367. '  Requisite VESA mode couldn't be found.  Return negative mode value as
  368. ' switch for calling routine to recognize that fact.
  369. '
  370. MODE=-1
  371. QUIT:
  372. DEF SEG
  373. END SUB
  374. '
  375. '  This is a "functionized" version of code extracted from a more general
  376. ' numeric base conversion program by Robert B. Relf, (C) 1984.  This just
  377. ' uses the part of Mr. Relf's code that converts decimal to binary.
  378. '
  379. FUNCTION BIN$(NUM AS LONG)
  380. DIM X AS INTEGER
  381. NUM=(NUM+65536&) MOD 65536&
  382. BIN1$=""
  383. FOR X=15 TO 0 STEP -1
  384. IF NUM>=(2^X) THEN
  385. BIN1$=BIN1$+"1"
  386. NUM=NUM-(2^X)
  387. ELSE
  388. BIN1$=BIN1$+"0"
  389. END IF
  390. NEXT X
  391. BIN1$=LEFT$(BIN1$,8)+RIGHT$(BIN1$,8)
  392. BIN$=BIN1$
  393. END FUNCTION
  394. '
  395. '  This subroutine is the analog of QB's intrinsic PSET statement.
  396. '
  397. SUB BPSET(XCOORD,YCOORD,CL)
  398. '
  399. '  Alias inputs in case they were input as numeric literals (which also
  400. ' serves to convert the viewport coordinates to screen coordinates).
  401. '
  402. C=CL : X=XCOORD+VXL : Y=YCOORD+VYL
  403. '
  404. '  Enforce viewport constraints.
  405. '
  406. IF X<VXL THEN X=VXL
  407. IF Y<VYL THEN Y=VYL
  408. IF X>VXR THEN X=VXR
  409. IF Y>VYR THEN Y=VYR
  410. INREGS.BX=256*CINT(ACPAGE)
  411. IF C<0 THEN C=DEFLTC
  412. INREGS.AX=3072+CINT(C)
  413. INREGS.CX=CINT(X)
  414. INREGS.DX=CINT(Y)
  415. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  416. END SUB
  417. '
  418. '  Subroutine BLINE emulates the functionality of QB's LINE statement.
  419. ' Except for LINE's "()" and "-" notation, BLINE's syntax is pretty much
  420. ' the same as LINE's.  The line style option is not supported here and
  421. ' the parameter specifying whether the drawn object is a line, box, or
  422. ' filled box ("L", "B", or "BF") must be in quotes in the CALL statement.
  423. ' Other than that, all parameters must be specified in the CALL.
  424. '
  425. SUB BLINE(XLC,YLC,XRC,YRC,CL,BOX$)
  426. '
  427. '  Alias input variables / convert to screen coordinates.
  428. '
  429. B$=UCASE$(BOX$) : C=CL : XL=XLC+VXL : YL=YLC+VYL : XR=XRC+VXL : YR=YRC+VYL
  430. '
  431. '  Enforce viewport constraints (if BVCBL <> 1).
  432. '
  433. IF BVCBL=1 THEN GOTO SKIPCON
  434. IF XL<VXL THEN XL=VXL
  435. IF YL<VYL THEN YL=VYL
  436. IF XR>VXR THEN XR=VXR
  437. IF YR>VYR THEN YR=VYR
  438. SKIPCON:
  439. '
  440. '  Set color to default color if it was input as negative.
  441. '
  442. IF C<0 THEN C=DEFLTC
  443. '
  444. '  If box isn't to be drawn, draw line.
  445. '
  446. IF B$<>"B" AND B$<>"BF" THEN
  447. IF XL<>XR THEN
  448. '
  449. '  Draw nonvertical line.
  450. '
  451. NPIX=CINT(SQR((XR-XL)^2+(YR-YL)^2)+.501)
  452. DXX=(XR-XL)/(NPIX-1)
  453. FOR I=1 TO NPIX
  454. X=(I-1)*DXX+XL
  455. Y=(YR-YL)*(X-XL)/(XR-XL)+YL
  456. INREGS.AX=3072+CINT(C)
  457. INREGS.BX=256*CINT(ACPAGE)
  458. INREGS.CX=CINT(X)
  459. INREGS.DX=CINT(Y)
  460. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  461. NEXT I
  462. ELSE
  463. '
  464. '  Draw vertical line.  (Watch out for upwardly directed lines and lines
  465. ' of zero length.)
  466. '
  467. ST=SGN(YR-YL) : IF ST=0 THEN ST=1
  468. FOR Y=YL TO YR STEP ST
  469. INREGS.AX=3072+CINT(C)
  470. INREGS.BX=256*CINT(ACPAGE)
  471. INREGS.CX=CINT(XL)
  472. INREGS.DX=CINT(Y)
  473. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  474. NEXT Y
  475. END IF
  476. '
  477. '  Draw box.
  478. '
  479. ELSE
  480. FOR Y=YL TO YR
  481. INREGS.AX=3072+CINT(C)
  482. INREGS.BX=256*CINT(ACPAGE)
  483. INREGS.CX=CINT(XL)
  484. INREGS.DX=CINT(Y)
  485. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  486. NEXT Y
  487. FOR X=XL+1 TO XR
  488. INREGS.AX=3072+CINT(C)
  489. INREGS.BX=256*CINT(ACPAGE)
  490. INREGS.CX=CINT(X)
  491. INREGS.DX=CINT(YR)
  492. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  493. NEXT X
  494. FOR Y=YR-1 TO YL STEP -1
  495. INREGS.AX=3072+CINT(C)
  496. INREGS.BX=256*CINT(ACPAGE)
  497. INREGS.CX=CINT(XR)
  498. INREGS.DX=CINT(Y)
  499. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  500. NEXT Y
  501. FOR X=XR-1 TO XL+1 STEP -1
  502. INREGS.AX=3072+CINT(C)
  503. INREGS.BX=256*CINT(ACPAGE)
  504. INREGS.CX=CINT(X)
  505. INREGS.DX=CINT(YL)
  506. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  507. NEXT X
  508. END IF
  509. '
  510. '  Fill box if told to do so.
  511. '
  512. IF B$="BF" THEN
  513. FOR Y=YL+1 TO YR-1
  514. FOR X=XL+1 TO XR-1
  515. INREGS.AX=3072+CINT(C)
  516. INREGS.BX=256*CINT(ACPAGE)
  517. INREGS.CX=CINT(X)
  518. INREGS.DX=CINT(Y)
  519. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  520. NEXT X
  521. NEXT Y
  522. END IF
  523. END SUB
  524. '
  525. '  Subroutine BCIRCLE emulates QB's CIRCLE statement.  The center is at
  526. ' (XCNT,YCNT), the radius is RAD, the color is CL, the starting angle is
  527. ' ST (radians), the ending angle is EN radians, and ASP is the aspect.
  528. ' (As always, all parameters must be specified.)  If EN = ST, a circle/
  529. ' ellipse is drawn.
  530. '
  531. SUB BCIRCLE(XCNT,YCNT,RAD,CL,ST,EN,ASP)
  532. '
  533. '  Use double precision calculations, set drawing page, and use default
  534. ' color if input color is negative.
  535. '
  536. DIM PI AS DOUBLE,A AS DOUBLE,DA AS DOUBLE,X AS DOUBLE,Y AS DOUBLE,XC AS DOUBLE
  537. DIM YC AS DOUBLE,R AS DOUBLE,ASPECT AS DOUBLE,SA AS DOUBLE,EA AS DOUBLE
  538. R=CDBL(RAD) : ASPECT=CDBL(ASP) : YC=CDBL(YCNT) : XC=CDBL(XCNT) : EA=CDBL(EN)
  539. SA=CDBL(ST) : C=CL
  540. IF ASPECT<0 THEN ASPECT=1#
  541. IF C<0 THEN C=DEFLTC
  542. '
  543. '  Define PI and test for/define circle condition.
  544. '
  545. PI=4#*ATN(1#)
  546. IF EA=SA THEN EA=SA+2#*PI
  547. NPIX=CINT(ABS(EA-SA)*R+.501)+1
  548. DA=(EA-SA)/CDBL(NPIX-1)
  549. '
  550. '  Draw arc/circle.
  551. '
  552. FOR I=1 TO NPIX
  553. A=DA*CDBL(I-1)+SA
  554. X=XC+R*COS(A) : Y=YC-R*SIN(A)
  555. IF ASPECT>1 THEN X=XC+R*COS(A)/ASPECT
  556. IF ASPECT<1 THEN Y=YC-R*ASPECT*SIN(A)
  557. '
  558. '  Enforce viewport constraints.
  559. '
  560. X=X+CDBL(VXL) : Y=Y+CDBL(VYL)
  561. IF X<VXL THEN X=VXL
  562. IF Y<VYL THEN Y=VYL
  563. IF X>VXR THEN X=VXR
  564. IF Y>VYR THEN Y=VYR
  565. INREGS.AX=3072+CINT(C)
  566. INREGS.BX=256*CINT(ACPAGE)
  567. INREGS.CX=CINT(X)
  568. INREGS.DX=CINT(Y)
  569. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  570. NEXT I
  571. END SUB
  572. '
  573. '  This is the analog of QB's CLS command.  BCLS clears the screen by
  574. ' putting it in the same video mode that it's already in.  CLSMODE = 0
  575. ' yields an effect equivalent to QB's CLS 0 and CLSMODE = 1 is like CLS 1.
  576. ' (The CLS 1 emulation does not involve the above mentioned mode change
  577. ' operation.  It uses the somewhat slower method of drawing a filled box
  578. ' with color 0.)
  579. '
  580. '
  581. SUB BCLS(CLSMODE)
  582. '
  583. '  Look for CLS 0/1 condition.  (If no viewport was defined, CLSMODE = 1
  584. ' will be treated as CLS 0.)
  585. '
  586. IF CLSMODE<>1 OR VCOL<0 THEN
  587. '
  588. '  How video mode is detected and changed depends on whether or not VESA
  589. ' bios is present.
  590. '
  591. IF VESSUP=1 THEN GOTO NOVESA
  592. INREGS.AX=&H4F03
  593. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  594. INREGS.AX=&H4F02
  595. INREGS.BX=OUTREGS.BX
  596. GOTO SETMODE
  597. NOVESA:
  598. INREGS.AX=&HF00
  599. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  600. INREGS.AX=OUTREGS.AX AND &HFF
  601. SETMODE:
  602. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  603. '
  604. '  Reset viewport defaults.  (Turn off viewport in case it was defined.)
  605. '
  606. VCOL=-1 : VXL=0 : VYL=0 : VXR=HMAX : VYR=VMAX
  607. ELSE
  608. CALL BVIEW(VXL,VYL,VXR,VYR,VCOL,VBORD)
  609. END IF
  610. END SUB
  611. '
  612. '  This subroutine sets the default color to CL.  (In spite of the "B"
  613. ' leading the subroutine name, there is no bios call involved here.)
  614. ' Unlike BSCREEN, BCOLOR will allow setting the default color to 0.
  615. '
  616. SUB BCOLOR(CL)
  617. DEFLTC=CL
  618. IF DEFLTC<0 THEN DEFLTC=7
  619. END SUB
  620. '
  621. '  BLOCATE emulates QB's LOCATE statement.  R is the row and C is the
  622. ' column.  (LOCATE's cursor control options are not supported.)
  623. '
  624. SUB BLOCATE(R,C)
  625. INREGS.AX=&H200
  626. '
  627. '  Get page number to print to.
  628. '
  629. INREGS.BX=256*CINT(ACPAGE)
  630. '
  631. '  Bios row and column numbers are zero-based.
  632. '
  633. INREGS.DX=256*CINT(R-1)+CINT(C-1)
  634. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  635. END SUB
  636. '
  637. '  BPRINT is the bios emulator for QB's PRINT statement.  It prints the
  638. ' input character string STRNG$ at the current cursor position.  It does
  639. ' not give a perfect emulation.  Semicolons and commas within STRNG$ are
  640. ' printed like any other character.  A semicolon at the end of STRNG$,
  641. ' however, suspends CR/LF printing just as with PRINT.  Hence, consecutive
  642. ' BPRINT CALLs can be made to achieve the same affect as with PRINT with
  643. ' embedded ";" characters.  Similarly, a comma at the end of STRNG$
  644. ' suppresses CR/LF printing and positions the cursor for the next BPRINT
  645. ' operation on the same line but at column (column after last character
  646. ' printed + 14) MOD 14, i.e., it attempts to emulate what an embedded
  647. ' comma in a PRINT statement would do.  STRNG$ can be a maximum of 126
  648. ' characters.  (It may be noted that QB functions such as STR$ and HEX$
  649. ' can be concatenated with other text to create most any string involving
  650. ' whatever numeric output you want.)
  651. '
  652. SUB BPRINT(STRNG$)
  653. DIM A(1 TO 32) AS LONG,ROW AS INTEGER,COL AS INTEGER,BYTE AS INTEGER
  654. DIM L AS INTEGER
  655. '
  656. '  Make various initializations.  (For one, STRNG$ is aliased with S$.)
  657. '
  658. SM=VARSEG(A(1)) : OS=VARPTR(A(1)) : INREGS.BP=CINT(OS) : S$=STRNG$ : L=LEN(S$)
  659. IF L=0 THEN S$=" " : L=1
  660. IF L>126 THEN L=126
  661. '
  662. '  S$ will be stored in array A.  Point memory pointer there and
  663. ' transfer characters.
  664. '
  665. DEF SEG=SM
  666. IF L>1 THEN
  667. FOR I=1 TO L-1
  668. BYTE=ASC(MID$(S$,I,1))
  669. POKE OS,BYTE
  670. OS=OS+1
  671. NEXT I
  672. END IF
  673. '
  674. '  Look for ";" or "," at end of S$.  Terminate stored string with CR/LF
  675. ' if these characters are absent.  Adjust number of characters (L) to be
  676. ' printed accordingly.
  677. '
  678. BYTE=ASC(MID$(S$,L,1))
  679. IF BYTE<>59 AND BYTE<>44 THEN
  680. POKE OS,BYTE
  681. OS=OS+1
  682. POKE OS,13
  683. OS=OS+1
  684. POKE OS,10
  685. L=L+2
  686. ELSE
  687. L=L-1
  688. END IF
  689. DEF SEG
  690. '
  691. '  Get page to print to and current cursor location and then print string
  692. ' there with default color.
  693. '
  694. INREGS.AX=&H300
  695. INREGS.BX=256*CINT(ACPAGE)
  696. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  697. INREGS.AX=&H1301
  698. INREGS.BX=CINT(DEFLTC)+256*CINT(ACPAGE)
  699. INREGS.CX=L
  700. INREGS.DX=OUTREGS.DX
  701. INREGS.ES=CINT(SM)
  702. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  703. IF BYTE=44 THEN
  704. INREGS.AX=&H300
  705. INREGS.BX=256*CINT(ACPAGE)
  706. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  707. ROW=(OUTREGS.DX AND &HFF00)/256
  708. COL=OUTREGS.DX AND &HFF
  709. COL=COL+14
  710. COL=14*INT(CSNG(COL+1)/14+.001)-1
  711. INREGS.AX=&H200
  712. INREGS.BX=256*CINT(ACPAGE)
  713. INREGS.DX=256*ROW+COL
  714. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  715. END IF
  716. END SUB
  717. '
  718. '  This function is the analog of QB's POINT function.  Unlike the other
  719. ' page-oriented routines, it reads data from the page being displayed.
  720. ' (QB's "POINT(number)" function is not emulated here.  The pixel color
  721. ' attribute returned is a 2-byte integer.)
  722. '
  723. DEFINT B
  724. FUNCTION BPOINT%(XCOORD,YCOORD)
  725. '
  726. '  Get displayed page.
  727. '
  728. INREGS.AX=&HF00
  729. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  730. '
  731. '  Translate (XCOORD,YCOORD) to screen coordinates and enforce viewport
  732. ' constraints.
  733. '
  734. X=XCOORD+VXL : Y=YCOORD+VYL
  735. IF X<VXL THEN X=VXL
  736. IF Y<VYL THEN Y=VYL
  737. IF X>VXR THEN X=VXR
  738. IF Y>VYR THEN Y=VYR
  739. '
  740. '  Get color attribute of pixel at (X,Y).
  741. '
  742. INREGS.AX=&HD00
  743. INREGS.BX=OUTREGS.BX
  744. INREGS.CX=CINT(X)
  745. INREGS.DX=CINT(Y)
  746. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  747. BPOINT=OUTREGS.AX AND &HFF
  748. END FUNCTION
  749. DEFSNG B
  750. '
  751. '  This is the analog of QB's graphics VIEW statement.  Input positive
  752. ' numbers for CL and BORDER to fill the viewport with color CL or draw
  753. ' a box around it with color BORDER.  (Use BORDER <= 0 to avoid drawing a
  754. ' a border.  Fill color is set to 0 if CL < 0.)
  755. '
  756. SUB BVIEW(XL,YL,XR,YR,CL,BORDER)
  757. VXL=CINT(XL) : VYL=CINT(YL) : VXR=CINT(XR) : VYR=CINT(YR)
  758. '
  759. '  Disallow plotting off-screen and make other reasonable enforcements.
  760. '
  761. IF VXL<0 THEN VXL=0
  762. IF VYL<0 THEN VYL=0
  763. IF VXR>HMAX THEN VXR=HMAX
  764. IF VYR>VMAX THEN VYR=VMAX
  765. IF VXL>HMAX THEN VXL=0
  766. IF VYL>VMAX THEN VYL=0
  767. IF VXR<0 THEN VXR=HMAX
  768. IF VYR<0 THEN VYR=VMAX
  769. IF VXR<=VXL THEN VXL=0 : VXR=HMAX
  770. IF VYR<=VYL THEN VYL=0 : VYR=VMAX
  771. '
  772. '  Process CL and BORDER arguments.  (Save them in global variables for
  773. ' BCLS subroutine.)
  774. '
  775. VCOL=CL : IF VCOL<0 THEN VCOL=0
  776. VBORD=BORDER
  777. '
  778. '  Clear viewport (fill with VCOL) and then draw border if appropriate.
  779. ' (Send BLINE viewport coordinates--it will convert them back to screen
  780. ' coordinates.)
  781. '
  782. CALL BLINE(0!,0!,VXR-VXL,VYR-VYL,VCOL,"BF")
  783. IF VBORD>0 THEN
  784. '
  785. '  Border is drawn just outside of viewport unless viewport encroaches on
  786. ' screen boundary.
  787. '
  788. XVL=VXL-1 : IF XVL<0 THEN XVL=0
  789. YVL=VYL-1 : IF YVL<0 THEN YVL=0
  790. XVR=VXR+1 : IF XVR>HMAX THEN XVR=HMAX
  791. YVR=VYR+1 : IF YVR>VMAX THEN YVR=VMAX
  792. '
  793. '  Turn off BLINE's enforcement of viewport limits.  (Turn it back on
  794. ' when call to BLINE is finished.)
  795. '
  796. BVCBL=1
  797. CALL BLINE(XVL-VXL,YVL-VYL,XVR-VXL,YVR-VYL,VBORD,"B")
  798. BVCBL=0
  799. END IF
  800. END SUB
  801. '
  802. '  This subroutine emulates QB's PAINT statement.  (The tiling option
  803. ' of QB's PAINT statement is not supported.)
  804. '
  805. SUB BPAINT(XP,YP,CL,BORDER)
  806. DIM CPIXEL AS INTEGER,I AS INTEGER,J AS INTEGER
  807. C=CL : IF C<0 THEN C=DEFLTC
  808. '
  809. '  Translate (XP,YP) to screen coordinates.
  810. '
  811. X=XP+VXL : Y=YP+VYL
  812. '
  813. '  If (X,Y) isn't within viewport, don't do anything.
  814. '
  815. IF X<VXL OR Y<VYL OR X>VXR OR Y>VYR THEN GOTO LEAVE
  816. '
  817. '  Set background color.  (Painting will only occur if current pixel is
  818. ' set to this color, which will be zero unless a filled viewport is
  819. ' active.)
  820. '
  821. CBACK=VCOL : IF CBACK<0 THEN CBACK=0
  822. '
  823. '  If (X,Y) is on border of area to be painted, no painting occurs.
  824. '
  825. INREGS.AX=&HD00
  826. INREGS.BX=256*CINT(ACPAGE)
  827. INREGS.CX=CINT(X)
  828. INREGS.DX=CINT(Y)
  829. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  830. CPIXEL=OUTREGS.AX AND &HFF
  831. IF CPIXEL<>CBACK THEN GOTO LEAVE
  832. '
  833. '  Begin painting.  Do points above input (X,Y) first.  (All calls to
  834. ' BPSET involve viewport coordinates.)
  835. '
  836. IF CINT(Y)>=VYL THEN
  837. FOR J=CINT(Y) TO VYL STEP -1
  838. '
  839. '  Do points to right of input (X,Y) first.
  840. '
  841. IF CINT(X)<=VXR THEN
  842. FOR I=CINT(X) TO VXR
  843. '
  844. '  Get pixel color at point (I,J).
  845. '
  846. INREGS.AX=&HD00
  847. INREGS.BX=256*CINT(ACPAGE)
  848. INREGS.CX=I
  849. INREGS.DX=J
  850. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  851. CPIXEL=OUTREGS.AX AND &HFF
  852. '
  853. '  Paint interior/exterior pixel with paint color, border pixel with
  854. ' border color (for non-negative BORDER input), or move to next part of
  855. ' figure.
  856. '
  857. IF CPIXEL=CBACK THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,C)
  858. IF CPIXEL<>CBACK THEN
  859. IF BORDER>=0 THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,BORDER)
  860. EXIT FOR
  861. END IF
  862. NEXT I
  863. END IF
  864. '
  865. '  Do points to left of input (X,Y).
  866. '
  867. IF CINT(X)-1>=VXL THEN
  868. FOR I=CINT(X)-1 TO VXL STEP -1
  869. INREGS.AX=&HD00
  870. INREGS.BX=256*CINT(ACPAGE)
  871. INREGS.CX=I
  872. INREGS.DX=J
  873. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  874. CPIXEL=OUTREGS.AX AND &HFF
  875. IF CPIXEL=CBACK THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,C)
  876. IF CPIXEL<>CBACK THEN
  877. IF BORDER>=0 THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,BORDER)
  878. EXIT FOR
  879. END IF
  880. NEXT I
  881. IF I=CINT(X)-1 THEN EXIT FOR
  882. END IF
  883. NEXT J
  884. END IF
  885. '
  886. '  Now do points below input (X,Y).
  887. '
  888. IF CINT(Y)+1<=VYR THEN
  889. FOR J=CINT(Y)+1 TO VYR
  890. IF CINT(X)<=VXR THEN
  891. FOR I=CINT(X) TO VXR
  892. INREGS.AX=&HD00
  893. INREGS.BX=256*CINT(ACPAGE)
  894. INREGS.CX=I
  895. INREGS.DX=J
  896. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  897. CPIXEL=OUTREGS.AX AND &HFF
  898. IF CPIXEL=CBACK THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,C)
  899. IF CPIXEL<>CBACK THEN
  900. IF BORDER>=0 THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,BORDER)
  901. EXIT FOR
  902. END IF
  903. NEXT I
  904. END IF
  905. IF CINT(X)-1>=VXL THEN
  906. FOR I=CINT(X)-1 TO VXL STEP -1
  907. INREGS.AX=&HD00
  908. INREGS.BX=256*CINT(ACPAGE)
  909. INREGS.CX=I
  910. INREGS.DX=J
  911. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  912. CPIXEL=OUTREGS.AX AND &HFF
  913. IF CPIXEL=CBACK THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,C)
  914. IF CPIXEL<>CBACK THEN
  915. IF BORDER>=0 THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,BORDER)
  916. EXIT FOR
  917. END IF
  918. NEXT I
  919. IF I=CINT(X)-1 THEN EXIT FOR
  920. END IF
  921. NEXT J
  922. END IF
  923. LEAVE:
  924. END SUB
  925. '
  926. '  This function emulates QB's POS *and* CRSLIN functions.  The current
  927. ' row (CROW) is returned via the parameter list and BPOS itself represents
  928. ' the current column.  (This function operates on the active video page,
  929. ' like most of the other page-oriented functions.)
  930. '
  931. FUNCTION BPOS(CROW)
  932. INREGS.AX=&H300
  933. INREGS.BX=256*CINT(ACPAGE)
  934. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  935. CROW=CSNG(OUTREGS.DX AND &HFF00)/256+1
  936. BPOS=CSNG(OUTREGS.DX AND &HFF)+1
  937. END FUNCTION
  938. '
  939. '  This subroutine emulates QB's PCOPY statement.
  940. '
  941. SUB BPCOPY(SPAGE,DPAGE)
  942. DIM X AS INTEGER,Y AS INTEGER
  943. FOR Y=0 TO CINT(VMAX)
  944. FOR X=0 TO CINT(HMAX)
  945. '
  946. '  Get color attribute of pixel at (X,Y) on SPAGE and set the attribute
  947. ' at the same location on DPAGE to this value.
  948. '
  949. INREGS.AX=&HD00
  950. INREGS.BX=256*CINT(SPAGE)
  951. INREGS.CX=X
  952. INREGS.DX=Y
  953. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  954. INREGS.AX=3072+(OUTREGS.AX AND &HFF)
  955. INREGS.BX=256*CINT(DPAGE)
  956. INREGS.CX=X
  957. INREGS.DX=Y
  958. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  959. NEXT X
  960. NEXT Y
  961. END SUB
  962. '
  963. '  This subroutine emulates QB's graphics GET statement.  However, it
  964. ' only stores the graphics data in a monochrome format.  Unlike GET, you
  965. ' do not input the actual name of the array to store the graphics data.
  966. ' Instead, after the coordinates for the upper lefthand and lower right-
  967. ' hand corners, you input the memory segment and offset of the array in
  968. ' which the data is to be stored via the variables SM and OS,
  969. ' respectively.  The array must be dimensioned in the calling routine
  970. ' just as it normally would.  SM and OS can be obtained in that routine
  971. ' via the commands
  972. '
  973. '   SM = VARSEG(A(1))
  974. '   OS = VARPTR(A(1))
  975. '
  976. ' where the name of the array was taken to "A" just for definitiveness
  977. ' and it was assumed that the array elements are 1-based.  (If they're
  978. ' 0-based, change the "1" to a "0" in the above commands.)  Do not forget
  979. ' to calculate these memory location parameters or MGET will likely crash
  980. ' your computer.
  981. '
  982. SUB MGET(XL,YL,XR,YR,SM,OS)
  983. DIM W AS INTEGER,H AS INTEGER
  984. '
  985. '  Alias SM because it will need to be changed if picture requires more
  986. ' than 65,535 bytes.
  987. '
  988. SM1=SM
  989. '
  990. '  Take into account graphics viewport and make sure rectangular screen
  991. ' area is defined correctly.
  992. '
  993. XMIN=VXL+XL : XMAX=VXL+XR : YMIN=VYL+YL : YMAX=VYL+YR
  994. IF XMIN>XMAX THEN SWAP XMIN,XMAX
  995. IF YMIN>YMAX THEN SWAP YMIN,YMAX
  996. '
  997. '  Get width and height of screen area and poke them into the array at
  998. ' memory location SM1:OS
  999. '
  1000. W=CINT(XMAX-XMIN)+1 : H=CINT(YMAX-YMIN)+1
  1001. WLOW=W AND &HFF : WHIGH=(W AND &HFF00)/256
  1002. HLOW=H AND &HFF : HHIGH=(H AND &HFF00)/256
  1003. '
  1004. '  Set pointer to memory segment.
  1005. '
  1006. DEF SEG=SM
  1007. POKE OS,WLOW
  1008. POKE OS+1,WHIGH
  1009. POKE OS+2,HLOW
  1010. POKE OS+3,HHIGH
  1011. '
  1012. '  Read screen pixels one-by-one, line-by-line.  (Define new offset
  1013. ' variable that can be updated as poking occurs.)
  1014. '
  1015. OFS=OS+4
  1016. '
  1017. '  Get number of whole bytes in each line and excess number of bits that
  1018. ' must be padded with zeros to make a complete byte.  (Take into account
  1019. ' graphics viewport.)
  1020. '
  1021. W8=8*INT(CSNG(W)/8+.001)
  1022. PEX=W-W8
  1023. FOR J=YMIN TO YMAX
  1024. '
  1025. '  Convert 8 bits at a time in line J to bytes and poke each byte into
  1026. ' array.  (All that matters here is whether the attribute of the pixel is
  1027. ' 0 or some color.  Any color but 0 is treated as a bit of one.)
  1028. '
  1029. IF W8>0 THEN
  1030. FOR I=XMIN TO XMIN+W8-1 STEP 8
  1031. V=0
  1032. FOR K=1 TO 8
  1033. INREGS.AX=&HD00
  1034. INREGS.BX=256*CINT(ACPAGE)
  1035. INREGS.CX=CINT(I+K-1)
  1036. INREGS.DX=CINT(J)
  1037. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1038. V=V+SGN(OUTREGS.AX AND &HFF)*2^(8-K)
  1039. NEXT K
  1040. POKE OFS,V
  1041. OFS=OFS+1
  1042. '
  1043. '  Watch out for constraint on offset.  If it's too large, move memory
  1044. ' pointer.
  1045. '
  1046. IF OFS>65535 THEN
  1047. SM1=SM1+4096
  1048. OFS=0
  1049. DEF SEG=SM1
  1050. END IF
  1051. NEXT I
  1052. END IF
  1053. IF PEX>0 THEN
  1054. V=0
  1055. FOR I=1 TO PEX
  1056. INREGS.AX=&HD00
  1057. INREGS.BX=256*CINT(ACPAGE)
  1058. INREGS.CX=CINT(XMIN+I+W8-1)
  1059. INREGS.DX=CINT(J)
  1060. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1061. V=V+SGN(OUTREGS.AX AND &HFF)*2^(8-I)
  1062. NEXT I
  1063. POKE OFS,V
  1064. OFS=OFS+1
  1065. IF OFS>65535 THEN
  1066. SM1=SM1+4096
  1067. OFS=0
  1068. DEF SEG=SM1
  1069. END IF
  1070. END IF
  1071. NEXT J
  1072. '
  1073. '  Graphics data is transferred.  Reset memory pointer.
  1074. '
  1075. DEF SEG
  1076. END SUB
  1077. '
  1078. '  This subroutine emulates QB's graphics PUT statement.  Like MGET, it
  1079. ' only displays a monochrome picture, and instead of inputting the name of
  1080. ' the array storing the picture, it inputs the memory segment and offset
  1081. ' of that array.  (See MGET for how to get those parameters.  Also,
  1082. ' although the data in the array does not necessarily need to have been
  1083. ' initially generated by MGET, make sure that data does in fact correspond
  1084. ' to a monochrome image.)  Although MPUT will only display a monochrome
  1085. ' picture, you can specify the (one) color to plot the lit pixels with via
  1086. ' the parameter CL.  (CL will revert to the default value if you specify
  1087. ' a non-positive value.)  ACT$ is a string variable specifying the action
  1088. ' verb.  It has the same interpretation as with PUT, but only in a mono-
  1089. ' chrome sense.
  1090. '
  1091. SUB MPUT(XOFF,YOFF,CL,SM,OS,ACT$)
  1092. DIM B AS LONG,BT AS INTEGER,CPIXEL AS INTEGER
  1093. '
  1094. '  Alias action verb and color and look for invalid values.
  1095. '
  1096. AV$=UCASE$(ACT$)
  1097. IF AV$<>"PRESET" AND AV$<>"XOR" AND AV$<>"OR" AND AV$<>"AND" THEN AV$="PSET"
  1098. C=CL : IF C<=0 THEN C=DEFLTC
  1099. '
  1100. '  Alias SM because it will need to be changed if picture requires more
  1101. ' than 65,535 bytes.
  1102. '
  1103. SM1=SM
  1104. '
  1105. '  Direct memory pointer to picture and peek it out of the array, line-by-
  1106. ' line, byte-by-byte, and treat bits in each byte as lit or unlit pixels.
  1107. '
  1108. DEF SEG=SM
  1109. '
  1110. '  First get width and height.
  1111. '
  1112. W=PEEK(OS)+256*PEEK(OS+1) : H=PEEK(OS+2)+256*PEEK(OS+3)
  1113. '
  1114. '  Get number of bytes in each line and define offset to be updated as
  1115. ' peeking occurs.
  1116. '
  1117. BYTES=INT((W+7)/8+.001) : OFS=OS+4
  1118. FOR J=1 TO H
  1119. '
  1120. '  Initialize horizontal plot coordinate.
  1121. '
  1122. X=XOFF
  1123. FOR I=1 TO BYTES
  1124. '
  1125. '  Get byte I and convert it to binary string.
  1126. '
  1127. B=CLNG(PEEK(OFS))
  1128. BIT$=BIN$(B)
  1129. OFS=OFS+1
  1130. '
  1131. '  Watch out for constraint on offset.  If it's too large, move memory
  1132. ' pointer.
  1133. '
  1134. IF OFS>65535 THEN
  1135. SM1=SM1+4096
  1136. OFS=0
  1137. DEF SEG=SM1
  1138. END IF
  1139. '
  1140. '  Plot bits.  (First 8 bits of two-byte string BIT$ don't count--they're
  1141. ' zero anyway.)
  1142. '
  1143. FOR K=9 TO 16
  1144. BT=VAL(MID$(BIT$,K,1))
  1145. '
  1146. '  If action verb isn't PSET, evaluate its effect on current screen pixel.
  1147. '
  1148. IF AV$<>"PSET" AND AV$<>"PRESET" THEN
  1149. INREGS.AX=&HD00
  1150. INREGS.BX=256*CINT(ACPAGE)
  1151. INREGS.CX=CINT(X+VXL)
  1152. INREGS.DX=CINT(VYL+YOFF+J-1)
  1153. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1154. CPIXEL=SGN(OUTREGS.AX AND &HFF)
  1155. IF AV$="OR" THEN BT=BT OR CPIXEL
  1156. IF AV$="AND" THEN BT=BT AND CPIXEL
  1157. IF AV$="XOR" THEN BT=BT XOR CPIXEL
  1158. END IF
  1159. IF AV$="PRESET" THEN BT=1% AND (NOT BT)
  1160. '
  1161. '  Take into account monochrome color to plot with.
  1162. '
  1163. BT=CINT(C)*BT
  1164. '
  1165. '  Don't plot bits if they're at a horizontal position past W--these bits
  1166. ' will exist if W isn't an integral multiple of 8.
  1167. '
  1168. IF X<=XOFF+W-1 THEN
  1169. INREGS.AX=3072+BT
  1170. INREGS.BX=256*CINT(ACPAGE)
  1171. INREGS.CX=CINT(X+VXL)
  1172. INREGS.DX=CINT(YOFF+VYL+J-1)
  1173. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1174. END IF
  1175. X=X+1
  1176. NEXT K
  1177. NEXT I
  1178. NEXT J
  1179. DEF SEG
  1180. END SUB
  1181. '
  1182. '  Like, MGET, this subroutine also emulates QB's graphics GET statement.
  1183. ' However, it supports color and is thus perhaps a better emulation.  See
  1184. ' MGET for further information regarding the variables in the parameter
  1185. ' list.
  1186. '
  1187. SUB BGET(XL,YL,XR,YR,SM,OS)
  1188. DIM W AS INTEGER,H AS INTEGER,B AS LONG,V AS INTEGER,WBITS AS INTEGER
  1189. '
  1190. '  Alias SM because it will need to be changed if picture requires more
  1191. ' than 65,535 bytes.
  1192. '
  1193. SM1=SM
  1194. '
  1195. '  Take into account graphics viewport and make sure rectangular screen
  1196. ' area is defined correctly.
  1197. '
  1198. XMIN=VXL+XL : XMAX=VXL+XR : YMIN=VYL+YL : YMAX=VYL+YR
  1199. IF XMIN>XMAX THEN SWAP XMIN,XMAX
  1200. IF YMIN>YMAX THEN SWAP YMIN,YMAX
  1201. '
  1202. '  Get width and height of screen area and poke them into the array at
  1203. ' memory location SM1:OS.
  1204. '
  1205. W=CINT(XMAX-XMIN)+1 : H=CINT(YMAX-YMIN)+1
  1206. WBITS=W*INT(BITSPIXEL/BITPLANES+.001)
  1207. WLOW=WBITS AND &HFF : WHIGH=(WBITS AND &HFF00)/256
  1208. HLOW=H AND &HFF : HHIGH=(H AND &HFF00)/256
  1209. '
  1210. '  Set pointer to memory segment.
  1211. '
  1212. DEF SEG=SM
  1213. POKE OS,WLOW
  1214. POKE OS+1,WHIGH
  1215. POKE OS+2,HLOW
  1216. POKE OS+3,HHIGH
  1217. '
  1218. '  Define new offset variable that can be updated as poking occurs.
  1219. '
  1220. OFS=OS+4
  1221. '
  1222. '  How graphics data is stored depends on number of bit planes per pixel.
  1223. ' (If number of bit planes per pixel isn't 4, take it to be one.)
  1224. '
  1225. IF BITPLANES<>4 THEN
  1226. '
  1227. '  Read screen pixels one-by-one, line-by-line, and poke their attributes
  1228. ' into memory.  (If there is only one bit plane per pixel, the video mode
  1229. ' likely supports 256 colors and each color requires 8 bits.)
  1230. '
  1231. FOR J=YMIN TO YMAX
  1232. FOR I=XMIN TO XMAX
  1233. INREGS.AX=&HD00
  1234. INREGS.BX=256*CINT(ACPAGE)
  1235. INREGS.CX=CINT(I)
  1236. INREGS.DX=CINT(J)
  1237. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1238. V=OUTREGS.AX AND &HFF
  1239. POKE OFS,V
  1240. OFS=OFS+1
  1241. '
  1242. '  Watch out for constraint on offset.  If it's too large, move memory
  1243. ' pointer.
  1244. '
  1245. IF OFS>65535 THEN
  1246. SM1=SM1+4096
  1247. OFS=0
  1248. DEF SEG=SM1
  1249. END IF
  1250. NEXT I
  1251. NEXT J
  1252. ELSE
  1253. '
  1254. '  If there is more than one bit plane per pixel, assume it's four.  In
  1255. ' other words, take the number of possible color attributes to be 16.
  1256. ' Each attribute requires 4 bits of memory.  These bits are labeled red,
  1257. ' green, blue, and intensity, or RGBI.  For each line of pixels, combine
  1258. ' the red bits into bytes and poke those bytes into memory and then repeat
  1259. ' for the green, blue, and intensity bits.  (One plane graphics are a lot
  1260. ' simpler!)
  1261. '
  1262. '  In reading the attribute byte from the screen, only last 4 bits of each
  1263. ' byte means anything here.  The neglected bits will be zero for a true
  1264. ' 16-color mode.  (If the neglected bits are in fact nonzero, it's likely
  1265. ' that your VESA bios didn't return correct information when FINDVESA
  1266. ' queried it, or else you used the SET MODE##= option of QBSVGA to define
  1267. ' a 16-color mode.  In that situation, QBSVGA will arbitrarily assume that
  1268. ' the number of bit planes per pixel is one.  (But, then, this section of
  1269. ' the program wouldn't be executing.))
  1270. '
  1271. DIM RED(1 TO W) AS INTEGER,GREEN(1 TO W) AS INTEGER,BLUE(1 TO W) AS INTEGER
  1272. DIM INTENSITY(1 TO W) AS INTEGER
  1273. '
  1274. '  If W isn't an even multiple of 8, extra zero bits must be added to the
  1275. ' RGBI data for each line to make a complete final byte.
  1276. '
  1277. W8=8*INT(CSNG(W)/8+.001)
  1278. PEX=W-W8
  1279. FOR J=YMIN TO YMAX
  1280. '
  1281. '  First, just store the RGBI bits for row J.
  1282. '
  1283. FOR I=XMIN TO XMAX
  1284. INREGS.AX=&HD00
  1285. INREGS.BX=256*CINT(ACPAGE)
  1286. INREGS.CX=CINT(I)
  1287. INREGS.DX=CINT(J)
  1288. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1289. B=CLNG(OUTREGS.AX AND &HFF)
  1290. BIT$=BIN$(B)
  1291. RED(I-XMIN+1)=VAL(MID$(BIT$,13,1))
  1292. GREEN(I-XMIN+1)=VAL(MID$(BIT$,14,1))
  1293. BLUE(I-XMIN+1)=VAL(MID$(BIT$,15,1))
  1294. INTENSITY(I-XMIN+1)=VAL(MID$(BIT$,16,1))
  1295. NEXT I
  1296. '
  1297. '  Poke RBGI data into memory.
  1298. '
  1299. IF W8>0 THEN
  1300. FOR I=1 TO W8 STEP 8
  1301. BYTE=0
  1302. FOR K=1 TO 8
  1303. BYTE=BYTE+2^(8-K)*RED(I+K-1)
  1304. NEXT K
  1305. POKE OFS,BYTE
  1306. OFS=OFS+1
  1307. IF OFS>65535 THEN
  1308. SM1=SM1+4096
  1309. OFS=0
  1310. DEF SEG=SM1
  1311. END IF
  1312. NEXT I
  1313. END IF
  1314. IF PEX>0 THEN
  1315. BYTE=0
  1316. FOR I=1 TO PEX
  1317. BYTE=BYTE+2^(8-I)*RED(I+W8)
  1318. NEXT I
  1319. POKE OFS,BYTE
  1320. OFS=OFS+1
  1321. IF OFS>65535 THEN
  1322. SM1=SM1+4096
  1323. OFS=0
  1324. DEF SEG=SM1
  1325. END IF
  1326. END IF
  1327. IF W8>0 THEN
  1328. FOR I=1 TO W8 STEP 8
  1329. BYTE=0
  1330. FOR K=1 TO 8
  1331. BYTE=BYTE+2^(8-K)*GREEN(I+K-1)
  1332. NEXT K
  1333. POKE OFS,BYTE
  1334. OFS=OFS+1
  1335. IF OFS>65535 THEN
  1336. SM1=SM1+4096
  1337. OFS=0
  1338. DEF SEG=SM1
  1339. END IF
  1340. NEXT I
  1341. END IF
  1342. IF PEX>0 THEN
  1343. BYTE=0
  1344. FOR I=1 TO PEX
  1345. BYTE=BYTE+2^(8-I)*GREEN(I+W8)
  1346. NEXT I
  1347. POKE OFS,BYTE
  1348. OFS=OFS+1
  1349. IF OFS>65535 THEN
  1350. SM1=SM1+4096
  1351. OFS=0
  1352. DEF SEG=SM1
  1353. END IF
  1354. END IF
  1355. IF W8>0 THEN
  1356. FOR I=1 TO W8 STEP 8
  1357. BYTE=0
  1358. FOR K=1 TO 8
  1359. BYTE=BYTE+2^(8-K)*BLUE(I+K-1)
  1360. NEXT K
  1361. POKE OFS,BYTE
  1362. OFS=OFS+1
  1363. IF OFS>65535 THEN
  1364. SM1=SM1+4096
  1365. OFS=0
  1366. DEF SEG=SM1
  1367. END IF
  1368. NEXT I
  1369. END IF
  1370. IF PEX>0 THEN
  1371. BYTE=0
  1372. FOR I=1 TO PEX
  1373. BYTE=BYTE+2^(8-I)*BLUE(I+W8)
  1374. NEXT I
  1375. POKE OFS,BYTE
  1376. OFS=OFS+1
  1377. IF OFS>65535 THEN
  1378. SM1=SM1+4096
  1379. OFS=0
  1380. DEF SEG=SM1
  1381. END IF
  1382. END IF
  1383. IF W8>0 THEN
  1384. FOR I=1 TO W8 STEP 8
  1385. BYTE=0
  1386. FOR K=1 TO 8
  1387. BYTE=BYTE+2^(8-K)*INTENSITY(I+K-1)
  1388. NEXT K
  1389. POKE OFS,BYTE
  1390. OFS=OFS+1
  1391. IF OFS>65535 THEN
  1392. SM1=SM1+4096
  1393. OFS=0
  1394. DEF SEG=SM1
  1395. END IF
  1396. NEXT I
  1397. END IF
  1398. IF PEX>0 THEN
  1399. BYTE=0
  1400. FOR I=1 TO PEX
  1401. BYTE=BYTE+2^(8-I)*INTENSITY(I+W8)
  1402. NEXT I
  1403. POKE OFS,BYTE
  1404. OFS=OFS+1
  1405. IF OFS>65535 THEN
  1406. SM1=SM1+4096
  1407. OFS=0
  1408. DEF SEG=SM1
  1409. END IF
  1410. END IF
  1411. NEXT J
  1412. END IF
  1413. '
  1414. '  Graphics data is transferred.  Reset memory pointer.
  1415. '
  1416. DEF SEG
  1417. END SUB
  1418. '
  1419. '  This subroutine emulates QB's graphics PUT statement in a manner that
  1420. ' supports color.  The variables in the call/parameter list are the same
  1421. ' as with MPUT except that the CL parameter should now be excluded.  (The
  1422. ' attributes in your picture now determine the colors, not some arbitrary
  1423. ' single value that you specify.)
  1424. '
  1425. SUB BPUT(XOFF,YOFF,SM,OS,ACT$)
  1426. DIM BT AS INTEGER,CPIXEL AS INTEGER,BYTE AS LONG
  1427. '
  1428. '  Alias action verb and look for invalid values.
  1429. '
  1430. AV$=UCASE$(ACT$)
  1431. IF AV$<>"PRESET" AND AV$<>"XOR" AND AV$<>"OR" AND AV$<>"AND" THEN AV$="PSET"
  1432. '
  1433. '  Alias SM because it will need to be changed if picture requires more
  1434. ' than 65,535 bytes.
  1435. '
  1436. SM1=SM
  1437. '
  1438. '  Direct memory pointer to picture and peek it out of the array, line-by-
  1439. ' line, byte-by-byte, and treat bits in each byte as lit or unlit pixels.
  1440. '
  1441. DEF SEG=SM
  1442. '
  1443. '  First get width and height.
  1444. '
  1445. W=PEEK(OS)+256*PEEK(OS+1) : H=PEEK(OS+2)+256*PEEK(OS+3)
  1446. W=INT(W*BITPLANES/BITSPIXEL+.001)
  1447. '
  1448. '  Define offset to be updated as peeking occurs.
  1449. '
  1450. OFS=OS+4
  1451. '
  1452. '  Plot data.  How graphics data is stored depends on number of bit planes
  1453. ' per pixel.
  1454. '
  1455. IF BITPLANES<>4 THEN
  1456. FOR J=1 TO H
  1457. '
  1458. '  Initialize horizontal plot coordinate.
  1459. '
  1460. X=XOFF
  1461. FOR I=1 TO W
  1462. BT=PEEK(OFS)
  1463. '
  1464. '  If action verb isn't PSET, evaluate its effect on current screen pixel.
  1465. '
  1466. IF AV$<>"PSET" AND AV$<>"PRESET" THEN
  1467. INREGS.AX=&HD00
  1468. INREGS.BX=256*CINT(ACPAGE)
  1469. INREGS.CX=CINT(X+VXL)
  1470. INREGS.DX=CINT(VYL+YOFF+J-1)
  1471. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1472. CPIXEL=OUTREGS.AX AND &HFF
  1473. IF AV$="OR" THEN BT=BT OR CPIXEL
  1474. IF AV$="AND" THEN BT=BT AND CPIXEL
  1475. IF AV$="XOR" THEN BT=BT XOR CPIXEL
  1476. END IF
  1477. IF AV$="PRESET" THEN BT=&HFF AND (NOT BT)
  1478. '
  1479. '  Plot pixel.
  1480. '
  1481. INREGS.AX=3072+BT
  1482. INREGS.BX=256*CINT(ACPAGE)
  1483. INREGS.CX=CINT(X+VXL)
  1484. INREGS.DX=CINT(YOFF+VYL+J-1)
  1485. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1486. X=X+1
  1487. OFS=OFS+1
  1488. '
  1489. '  Watch out for constraint on offset.  If it's too large, move memory
  1490. ' pointer.
  1491. '
  1492. IF OFS>65535 THEN
  1493. SM1=SM1+4096
  1494. OFS=0
  1495. DEF SEG=SM1
  1496. END IF
  1497. NEXT I
  1498. NEXT J
  1499. ELSE
  1500. DIM RED(1 TO W) AS INTEGER,GREEN(1 TO W) AS INTEGER,BLUE(1 TO W) AS INTEGER
  1501. DIM INTENSITY(1 TO W) AS INTEGER
  1502. W8=8*INT(W/8+.001)
  1503. PEX=W-W8
  1504. FOR J=1 TO H
  1505. '
  1506. '  Get RGBI data for row J.
  1507. '
  1508. IF W8>0 THEN
  1509. FOR I=1 TO W8 STEP 8
  1510. BYTE=CLNG(PEEK(OFS))
  1511. BIT$=BIN$(BYTE)
  1512. FOR K=1 TO 8
  1513. RED(K+I-1)=VAL(MID$(BIT$,8+K,1))
  1514. NEXT K
  1515. OFS=OFS+1
  1516. IF OFS>65535 THEN
  1517. SM1=SM1+4096
  1518. OFS=0
  1519. DEF SEG=SM1
  1520. END IF
  1521. NEXT I
  1522. END IF
  1523. IF PEX>0 THEN
  1524. BYTE=CLNG(PEEK(OFS))
  1525. BIT$=BIN$(BYTE)
  1526. FOR I=1 TO PEX
  1527. RED(I+W8)=VAL(MID$(BIT$,8+I,1))
  1528. NEXT I
  1529. OFS=OFS+1
  1530. IF OFS>65535 THEN
  1531. SM1=SM1+4096
  1532. OFS=0
  1533. DEF SEG=SM1
  1534. END IF
  1535. END IF
  1536. IF W8>0 THEN
  1537. FOR I=1 TO W8 STEP 8
  1538. BYTE=CLNG(PEEK(OFS))
  1539. BIT$=BIN$(BYTE)
  1540. FOR K=1 TO 8
  1541. GREEN(K+I-1)=VAL(MID$(BIT$,8+K,1))
  1542. NEXT K
  1543. OFS=OFS+1
  1544. IF OFS>65535 THEN
  1545. SM1=SM1+4096
  1546. OFS=0
  1547. DEF SEG=SM1
  1548. END IF
  1549. NEXT I
  1550. END IF
  1551. IF PEX>0 THEN
  1552. BYTE=CLNG(PEEK(OFS))
  1553. BIT$=BIN$(BYTE)
  1554. FOR I=1 TO PEX
  1555. GREEN(I+W8)=VAL(MID$(BIT$,8+I,1))
  1556. NEXT I
  1557. OFS=OFS+1
  1558. IF OFS>65535 THEN
  1559. SM1=SM1+4096
  1560. OFS=0
  1561. DEF SEG=SM1
  1562. END IF
  1563. END IF
  1564. IF W8>0 THEN
  1565. FOR I=1 TO W8 STEP 8
  1566. BYTE=CLNG(PEEK(OFS))
  1567. BIT$=BIN$(BYTE)
  1568. FOR K=1 TO 8
  1569. BLUE(K+I-1)=VAL(MID$(BIT$,8+K,1))
  1570. NEXT K
  1571. OFS=OFS+1
  1572. IF OFS>65535 THEN
  1573. SM1=SM1+4096
  1574. OFS=0
  1575. DEF SEG=SM1
  1576. END IF
  1577. NEXT I
  1578. END IF
  1579. IF PEX>0 THEN
  1580. BYTE=CLNG(PEEK(OFS))
  1581. BIT$=BIN$(BYTE)
  1582. FOR I=1 TO PEX
  1583. BLUE(I+W8)=VAL(MID$(BIT$,8+I,1))
  1584. NEXT I
  1585. OFS=OFS+1
  1586. IF OFS>65535 THEN
  1587. SM1=SM1+4096
  1588. OFS=0
  1589. DEF SEG=SM1
  1590. END IF
  1591. END IF
  1592. IF W8>0 THEN
  1593. FOR I=1 TO W8 STEP 8
  1594. BYTE=CLNG(PEEK(OFS))
  1595. BIT$=BIN$(BYTE)
  1596. FOR K=1 TO 8
  1597. INTENSITY(K+I-1)=VAL(MID$(BIT$,8+K,1))
  1598. NEXT K
  1599. OFS=OFS+1
  1600. IF OFS>65535 THEN
  1601. SM1=SM1+4096
  1602. OFS=0
  1603. DEF SEG=SM1
  1604. END IF
  1605. NEXT I
  1606. END IF
  1607. IF PEX>0 THEN
  1608. BYTE=CLNG(PEEK(OFS))
  1609. BIT$=BIN$(BYTE)
  1610. FOR I=1 TO PEX
  1611. INTENSITY(I+W8)=VAL(MID$(BIT$,8+I,1))
  1612. NEXT I
  1613. OFS=OFS+1
  1614. IF OFS>65535 THEN
  1615. SM1=SM1+4096
  1616. OFS=0
  1617. DEF SEG=SM1
  1618. END IF
  1619. END IF
  1620. '
  1621. '  The rest of this is pretty much like the single bit plane case, above.
  1622. '
  1623. X=XOFF
  1624. FOR I=1 TO W
  1625. BT=8*RED(I)+4*GREEN(I)+2*BLUE(I)+INTENSITY(I)
  1626. IF AV$<>"PSET" AND AV$<>"PRESET" THEN
  1627. INREGS.AX=&HD00
  1628. INREGS.BX=256*CINT(ACPAGE)
  1629. INREGS.CX=CINT(X+VXL)
  1630. INREGS.DX=CINT(VYL+YOFF+J-1)
  1631. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1632. CPIXEL=OUTREGS.AX AND &HFF
  1633. IF AV$="OR" THEN BT=BT OR CPIXEL
  1634. IF AV$="AND" THEN BT=BT AND CPIXEL
  1635. IF AV$="XOR" THEN BT=BT XOR CPIXEL
  1636. END IF
  1637. IF AV$="PRESET" THEN BT=15% AND (NOT BT)
  1638. INREGS.AX=3072+BT
  1639. INREGS.BX=256*CINT(ACPAGE)
  1640. INREGS.CX=CINT(X+VXL)
  1641. INREGS.DX=CINT(YOFF+VYL+J-1)
  1642. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1643. X=X+1
  1644. NEXT I
  1645. NEXT J
  1646. END IF
  1647. DEF SEG
  1648. END SUB
  1649. '
  1650. '  This function returns -1 if a mouse driver is installed via interrupt
  1651. ' 33h.  (It should return 0 otherwise.  Note the variable type of
  1652. ' QRYMOUSE.)  The number of buttons is returned via the global BUTTONS
  1653. ' variable.
  1654. '
  1655. DEFINT Q
  1656. FUNCTION QRYMOUSE%
  1657. DIM DOSVER AS INTEGER
  1658. '
  1659. '  If DOS version isn't > 1, rodents don't work.
  1660. '
  1661. INREGS.AX=&H3000
  1662. CALL INTERRUPTX(&H21,INREGS,OUTREGS)
  1663. DOSVER=OUTREGS.AX AND &HFF
  1664. QRYMOUSE=0
  1665. IF DOSVER>1 THEN
  1666. INREGS.AX=0
  1667. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1668. QRYMOUSE=OUTREGS.AX
  1669. BUTTONS=CSNG(OUTREGS.BX)
  1670. '
  1671. '  Set default color for mouse cursor and initialize mouse position
  1672. ' variables.
  1673. '
  1674. MCOLOR=15 : XMOUSE=-1 : YMOUSE=-1
  1675. END IF
  1676. END FUNCTION
  1677. DEFSNG Q
  1678. '
  1679. '  This subroutine initializes the mouse motion characteristics.  You
  1680. ' don't generally need to worry about this routine.  BSCREEN calls it if
  1681. ' a mouse driver is present.
  1682. '
  1683. SUB MOUSINIT
  1684. CALL GETLIM
  1685. CALL SETLIM(0!,0!,HMAX,VMAX)
  1686. END SUB
  1687. '
  1688. '  This subroutine calculates the horizontal (MXMAX) and vertical (MYMAX)
  1689. ' limits on mouse cursor motion and the horizontal (MDX) and vertical
  1690. ' (MDY) cursor motion discretization in the current video mode.  (There
  1691. ' are, for example, MDX mouse movement pixels for each horizontal screen
  1692. ' pixel.)  These are global quantites.  These limits are the ones set by
  1693. ' the video state.  Subroutine SETLIM can be used to enforce smaller
  1694. ' constraints.  (You don't actually need to call GETLIM; subroutine
  1695. ' MOUSINIT does that.)
  1696. '
  1697. SUB GETLIM
  1698. MXMAX=0
  1699. KX=0
  1700. FOR I=0 TO 8000
  1701. INREGS.AX=4
  1702. INREGS.CX=I
  1703. INREGS.DX=0
  1704. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1705. INREGS.AX=3
  1706. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1707. IF OUTREGS.CX=I THEN
  1708. KX=KX+1
  1709. MXMAX=I
  1710. END IF
  1711. NEXT I
  1712. MYMAX=0
  1713. KY=0
  1714. FOR I=0 TO 5000
  1715. INREGS.AX=4
  1716. INREGS.CX=0
  1717. INREGS.DX=I
  1718. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1719. INREGS.AX=3
  1720. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1721. IF OUTREGS.DX=I THEN
  1722. KY=KY+1
  1723. MYMAX=I
  1724. END IF
  1725. NEXT I
  1726. IF KX>1 THEN
  1727. MDX=MXMAX/(KX-1)
  1728. END IF
  1729. IF KY>1 THEN
  1730. MDY=MYMAX/(KY-1)
  1731. END IF
  1732. '
  1733. '  The values of MXMAX and MYMAX, especially the latter, may or may not be
  1734. ' particularly meaningful in regard to a specific correlation with the
  1735. ' particular screen resolution.  Make them so.
  1736. '
  1737. MXMAX=MDX*INT(HMAX/MDX+.001) : MYMAX=MDY*INT(VMAX/MDY+.001)
  1738. END SUB
  1739. '
  1740. '  This subroutine sets the limits on the screen over which the mouse
  1741. ' cursor may move.  (XMIN,YMIN) is the upper lefthand corner of the
  1742. ' rectangle in which the cursor moves and (XMAX,YMAX) is the lower right-
  1743. ' hand corner.  GETLIM should be called before SETLIM (so MDX and MDY can
  1744. ' be computed properly) and SETLIM aliases the new cursor limits with
  1745. ' global variables for subroutine GETPOS.
  1746. '
  1747. SUB SETLIM(XMIN,YMIN,XMAX,YMAX)
  1748. '
  1749. '  Enforce consistency with mouse and screen characteristics in current
  1750. ' video mode.
  1751. '
  1752. XMIN1=CINT(MDX)*INT(XMIN/MDX+.501) : IF XMIN1<0 THEN XMIN1=0
  1753. XMAX1=CINT(MDX)*INT(XMAX/MDX+.001) : IF XMAX1>MXMAX THEN XMAX1=MXMAX
  1754. YMIN1=CINT(MDY)*INT(YMIN/MDY+.501) : IF YMIN1<0 THEN YMIN1=0
  1755. YMAX1=CINT(MDY)*INT(YMAX/MDY+.001) : IF YMAX1>MYMAX THEN YMAX1=MYMAX
  1756. IF XMAX1<=XMIN1 THEN XMIN1=0 : XMAX1=MXMAX
  1757. IF YMAX1<=YMIN1 THEN YMIN1=0 : YMAX1=MYMAX
  1758. '
  1759. '  Restrict horizontal movement.
  1760. '
  1761. INREGS.AX=7
  1762. INREGS.CX=CINT(XMIN1*MDX)
  1763. INREGS.DX=CINT(XMAX1*MDX)
  1764. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1765. '
  1766. '  Restrict vertical movement.
  1767. '
  1768. INREGS.AX=8
  1769. INREGS.CX=CINT(YMIN1*MDY)
  1770. INREGS.DX=CINT(YMAX1*MDY)
  1771. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1772. '
  1773. '  Save mouse constraints in global variables.
  1774. '
  1775. MXMINC=XMIN1 : MXMAXC=XMAX1 : MYMINC=YMIN1 : MYMAXC=YMAX1
  1776. END SUB
  1777. '
  1778. '  This subroutine turns a simulated SVGA mouse cursor on and watches its
  1779. ' movement around the screen.  It returns the (X,Y) screen position of the
  1780. ' cursor when a button is pressed.  BUTTON is output as 0 if the left
  1781. ' button was pressed, 1 if the right button was pressed, and 2 if the
  1782. ' middle one (Mouse Systems) was pressed.  Don't call this subroutine
  1783. ' until after calling GETLIM (and SETLIM, if you're using SETLIM at all).
  1784. ' Also, the mouse routines work exclusively in screen coordinates; they
  1785. ' make their own bios calls, independently of the bios calls made by the
  1786. ' other QBSVGA routines.  (A consequence of this is that this routine
  1787. ' only supports use of a mouse in a graphic screen mode.  Another
  1788. ' consequence is that, since the graphics viewport is ignored, the
  1789. ' coordinates output by GETPOS (and BOXDRAG, below) must be converted to
  1790. ' viewport coordinates before you use them with the other QBSVGA routines.
  1791. ' This is done by subtracting VXL from X and VYL from Y, assuming a
  1792. ' graphics viewport is defined at all.)
  1793. '
  1794. SUB GETPOS(X,Y,BUTTON)
  1795. DIM XOLD AS INTEGER,YOLD AS INTEGER,VPAGE AS INTEGER,I AS INTEGER,XM AS INTEGER
  1796. DIM YM AS INTEGER,XOUT(1 TO 3),YOUT(1 TO 3),RODBAK(1 TO 34) AS INTEGER
  1797. '
  1798. '  Mouse motion wouldn't be too useful on non-displayed page.  Get visible
  1799. ' page.  (Leave it as stored in the high byte of register BX.)
  1800. '
  1801. INREGS.AX=&HF00
  1802. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1803. VPAGE=OUTREGS.BX
  1804. '
  1805. '  Save portion of screen where simulated rodent cursor is initially going
  1806. ' to be positioned in global array RODBAK.  (First, fix initial position
  1807. ' of cursor to avoid crash--or put it at last position of cursor.)
  1808. '
  1809. INREGS.AX=4
  1810. INREGS.CX=CINT(MDX)*XMOUSE
  1811. IF INREGS.CX<0 THEN INREGS.CX=CINT(MDX)*INT((MXMAXC+MXMINC)/2/MDX+.001)
  1812. INREGS.DX=CINT(MDY)*YMOUSE
  1813. IF INREGS.DX<0 THEN INREGS.DX=CINT(MDY)*INT((MYMAXC+MYMINC)/2/MDY+.001)
  1814. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1815. '
  1816. '  Get unequivocal position of cursor now that its position has been set.
  1817. '
  1818. INREGS.AX=3
  1819. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1820. YOLD=INT(CSNG(OUTREGS.DX)/MDY+.001) : XOLD=INT(CSNG(OUTREGS.CX)/MDX+.001)
  1821. '
  1822. '  Save portion of background beneath cross-hair.
  1823. '
  1824. FOR I=1 TO 17
  1825. INREGS.AX=&HD00
  1826. INREGS.BX=VPAGE
  1827. INREGS.CX=XOLD+I-9
  1828. INREGS.DX=YOLD
  1829. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1830. RODBAK(I)=OUTREGS.AX AND &HFF
  1831. INREGS.AX=&HD00
  1832. INREGS.BX=VPAGE
  1833. INREGS.CX=XOLD
  1834. INREGS.DX=YOLD+I-9
  1835. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1836. RODBAK(I+17)=OUTREGS.AX AND &HFF
  1837. NEXT I
  1838. '
  1839. '  CMOT is nonzero when rodent moves.  Initially, artificially force
  1840. ' motion detection and initialize BIOS motion detection function.  (Cursor
  1841. ' is only drawn after cursor motion is detected, rather than continuously,
  1842. ' to avoid undue "flickering.")
  1843. '
  1844. CMOT=1
  1845. INREGS.AX=&HB
  1846. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1847. '
  1848. '  Start moving cursor around and wait for button to be pressed.  (A
  1849. ' negative value for BUTTON means that nothing has been pressed yet.)
  1850. '
  1851. GETBUTTON:
  1852. BUTTON=-1
  1853. INREGS.AX=5
  1854. INREGS.BX=0
  1855. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1856. YOUT(1)=INT(CSNG(OUTREGS.DX)/MDY+.001) : XOUT(1)=INT(CSNG(OUTREGS.CX)/MDX+.001)
  1857. IF OUTREGS.BX>0 THEN BUTTON=0
  1858. IF BUTTONS>1 THEN
  1859. INREGS.AX=5
  1860. INREGS.BX=1
  1861. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1862. YOUT(2)=INT(CSNG(OUTREGS.DX)/MDY+.001) : XOUT(2)=INT(CSNG(OUTREGS.CX)/MDX+.001)
  1863. IF OUTREGS.BX>0 THEN BUTTON=1
  1864. END IF
  1865. IF BUTTONS>2 THEN
  1866. INREGS.AX=5
  1867. INREGS.BX=2
  1868. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1869. YOUT(3)=INT(CSNG(OUTREGS.DX)/MDY+.001) : XOUT(3)=INT(CSNG(OUTREGS.CX)/MDX+.001)
  1870. IF OUTREGS.BX>0 THEN BUTTON=2
  1871. END IF
  1872. '
  1873. '  Was button pressed?
  1874. '
  1875. IF BUTTON>=0 THEN GOTO EXITROD
  1876. '
  1877. '  Button wasn't pressed.  Get screen position of cursor dynamically.
  1878. '
  1879. INREGS.AX=3
  1880. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1881. YM=INT(CSNG(OUTREGS.DX)/MDY+.001) : XM=INT(CSNG(OUTREGS.CX)/MDX+.001)
  1882. '
  1883. '  Save portion of screen where simulated cursor is to be and draw cursor.
  1884. ' (First, however, restore original pixel data.)
  1885. '
  1886. IF CMOT<>0 THEN
  1887. FOR I=1 TO 17
  1888. INREGS.AX=3072+RODBAK(I)
  1889. INREGS.BX=VPAGE
  1890. INREGS.CX=XOLD+I-9
  1891. INREGS.DX=YOLD
  1892. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1893. INREGS.AX=3072+RODBAK(I+17)
  1894. INREGS.BX=VPAGE
  1895. INREGS.CX=XOLD
  1896. INREGS.DX=YOLD+I-9
  1897. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1898. NEXT I
  1899. FOR I=1 TO 17
  1900. INREGS.AX=&HD00
  1901. INREGS.BX=VPAGE
  1902. INREGS.CX=XM+I-9
  1903. INREGS.DX=YM
  1904. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1905. RODBAK(I)=OUTREGS.AX AND &HFF
  1906. INREGS.AX=&HD00
  1907. INREGS.BX=VPAGE
  1908. INREGS.CX=XM
  1909. INREGS.DX=YM+I-9
  1910. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1911. RODBAK(I+17)=OUTREGS.AX AND &HFF
  1912. NEXT I
  1913. XOLD=XM : YOLD=YM
  1914. '
  1915. '  Draw cursor.
  1916. '
  1917. FOR I=-8 TO 8
  1918. INREGS.AX=3072+MCOLOR
  1919. INREGS.BX=VPAGE
  1920. INREGS.CX=XM+I
  1921. INREGS.DX=YM
  1922. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1923. INREGS.AX=3072+MCOLOR
  1924. INREGS.BX=VPAGE
  1925. INREGS.CX=XM
  1926. INREGS.DX=YM+I
  1927. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1928. NEXT I
  1929. END IF
  1930. '
  1931. '  Look for cursor motion and update CMOT.
  1932. '
  1933. INREGS.AX=&HB
  1934. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  1935. CMOT=ABS(OUTREGS.CX)+ABS(OUTREGS.DX)
  1936. GOTO GETBUTTON
  1937. EXITROD:
  1938. '
  1939. '  Output whichever pair of (XOUT,YOUT) corresponds to the button pressed.
  1940. '
  1941. X=XOUT(BUTTON+1) : Y=YOUT(BUTTON+1)
  1942. '
  1943. '  Save last dynamic position in global variables so next call to GETPOS
  1944. ' can position cursor to where it was last time.
  1945. '
  1946. XMOUSE=XM : YMOUSE=YM
  1947. '
  1948. '  Turn cursor off.
  1949. '
  1950. FOR I=1 TO 17
  1951. INREGS.AX=3072+RODBAK(I)
  1952. INREGS.BX=VPAGE
  1953. INREGS.CX=XOLD+I-9
  1954. INREGS.DX=YOLD
  1955. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1956. INREGS.AX=3072+RODBAK(I+17)
  1957. INREGS.BX=VPAGE
  1958. INREGS.CX=XOLD
  1959. INREGS.DX=YOLD+I-9
  1960. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1961. NEXT I
  1962. END SUB
  1963. '
  1964. '  Like GETPOS, this subroutine allows a mouse cursor to be moved around
  1965. ' the screen.  However, it doesn't simply return the position (XP,YP) of
  1966. ' the cursor when a button is pressed.  Rather, when a button is pressed,
  1967. ' it watches for the button to be released, returning both the position
  1968. ' when the button is pressed and the position (XR,YR) when the button was
  1969. ' released.  In between, the cursor may be moved around and a bounding
  1970. ' rectangle follows its movement.  (The cursor is not shown in this second
  1971. ' movement phase--the moving corner of the rectangle serves the equivalent
  1972. ' function.)  In other words, this subroutine performs a "click and drag
  1973. ' with bounding box" operation.  It uses GETPOS to find the initial press
  1974. ' position and returns the button pressed/released as BUTTON.  (See GETPOS
  1975. ' for the interpretation of BUTTON.)  The rectangle is drawn with the
  1976. ' MCOLOR attribute set by QRYMOUSE (or by an explicit assignment after
  1977. ' QRYMOUSE, via BSCREEN, is used).
  1978. '
  1979. '  Like, GETPOS, the outputs XP, YP, XR, and YR are screen coordinates,
  1980. ' not viewport coordinates.  If a graphics viewport is defined, they must
  1981. ' be converted to viewport coordinates before using them with the other
  1982. ' QBSVGA routines.  (VXL must be subtracted from XP and XR, and VYL must
  1983. ' be subtracted from YP and YR.)
  1984. '
  1985. SUB BOXDRAG(XP,YP,XR,YR,BUTTON)
  1986. DIM VPAGE AS INTEGER,I AS INTEGER,XM AS INTEGER,YM AS INTEGER,XSTEP AS INTEGER
  1987. DIM YSTEP AS INTEGER,BOXBAK(1 TO 2*(HMAX+VMAX)) AS STRING*1,XOLD AS INTEGER
  1988. DIM YOLD AS INTEGER,CTEMP AS INTEGER
  1989. '
  1990. '  Get displayed page and leave it as stored in high byte of BX register.
  1991. '
  1992. INREGS.AX=&HF00
  1993. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  1994. VPAGE=OUTREGS.BX
  1995. '
  1996. '  Get button-press position.
  1997. '
  1998. CALL GETPOS(XP,YP,BUTTON)
  1999. '
  2000. '  Now watch for button-release.  (Initialize release counter, CMOT, and
  2001. ' motion detector.)
  2002. '
  2003. CMOT=1
  2004. INREGS.AX=&HB
  2005. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  2006. INREGS.AX=6
  2007. INREGS.BX=CINT(BUTTON)
  2008. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  2009. '
  2010. '  PASS becomes nonzero when box has been drawn at least once.  (This is
  2011. ' necessary in order to keep previous box pixels from being treated as box
  2012. ' background.)
  2013. '
  2014. PASS=0
  2015. GETRELEASE:
  2016. '
  2017. '  RELEASE = 0 if button has not been released.
  2018. '
  2019. RELEASE=0
  2020. INREGS.AX=6
  2021. INREGS.BX=CINT(BUTTON)
  2022. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  2023. IF OUTREGS.BX>0 THEN RELEASE=1
  2024. '
  2025. '  Get position of cursor dynamically.
  2026. '
  2027. INREGS.AX=3
  2028. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  2029. YM=INT(CSNG(OUTREGS.DX)/MDY+.001) : XM=INT(CSNG(OUTREGS.CX)/MDX+.001)
  2030. IF CMOT<>0 THEN
  2031. '
  2032. '  Save background beneath box and draw it one point at a time.
  2033. '
  2034. XSTEP=1 : IF XM<CINT(XP) THEN XSTEP=-XSTEP
  2035. YSTEP=1 : IF YM<CINT(YP) THEN YSTEP=-YSTEP
  2036. '
  2037. '  Index K counts position in BOXBAK array.
  2038. '
  2039. K=1
  2040. FOR I=CINT(YP) TO YM STEP YSTEP
  2041. INREGS.AX=&HD00
  2042. INREGS.BX=VPAGE
  2043. INREGS.CX=CINT(XP)
  2044. INREGS.DX=I
  2045. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2046. CTEMP=OUTREGS.AX AND &HFF
  2047. IF PASS=0 OR (PASS>0 AND CTEMP<>MCOLOR) THEN BOXBAK(K)=CHR$(CTEMP)
  2048. INREGS.AX=3072+MCOLOR
  2049. INREGS.BX=VPAGE
  2050. INREGS.CX=CINT(XP)
  2051. INREGS.DX=I
  2052. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2053. K=K+1
  2054. NEXT I
  2055. FOR I=CINT(XP)+XSTEP TO XM STEP XSTEP
  2056. INREGS.AX=&HD00
  2057. INREGS.BX=VPAGE
  2058. INREGS.CX=I
  2059. INREGS.DX=YM
  2060. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2061. CTEMP=OUTREGS.AX AND &HFF
  2062. IF PASS=0 OR (PASS>0 AND CTEMP<>MCOLOR) THEN BOXBAK(K)=CHR$(CTEMP)
  2063. INREGS.AX=3072+MCOLOR
  2064. INREGS.BX=VPAGE
  2065. INREGS.CX=I
  2066. INREGS.DX=YM
  2067. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2068. K=K+1
  2069. NEXT I
  2070. FOR I=YM-YSTEP TO CINT(YP) STEP -YSTEP
  2071. INREGS.AX=&HD00
  2072. INREGS.BX=VPAGE
  2073. INREGS.CX=XM
  2074. INREGS.DX=I
  2075. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2076. CTEMP=OUTREGS.AX AND &HFF
  2077. IF PASS=0 OR (PASS>0 AND CTEMP<>MCOLOR) THEN BOXBAK(K)=CHR$(CTEMP)
  2078. INREGS.AX=3072+MCOLOR
  2079. INREGS.BX=VPAGE
  2080. INREGS.CX=XM
  2081. INREGS.DX=I
  2082. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2083. K=K+1
  2084. NEXT I
  2085. FOR I=XM-XSTEP TO CINT(XP)+XSTEP STEP -XSTEP
  2086. INREGS.AX=&HD00
  2087. INREGS.BX=VPAGE
  2088. INREGS.CX=I
  2089. INREGS.DX=CINT(YP)
  2090. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2091. CTEMP=OUTREGS.AX AND &HFF
  2092. IF PASS=0 OR (PASS>0 AND CTEMP<>MCOLOR) THEN BOXBAK(K)=CHR$(CTEMP)
  2093. INREGS.AX=3072+MCOLOR
  2094. INREGS.BX=VPAGE
  2095. INREGS.CX=I
  2096. INREGS.DX=CINT(YP)
  2097. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2098. K=K+1
  2099. NEXT I
  2100. '
  2101. '  Save XM and YM for later background restoration and update PASS.
  2102. '
  2103. XOLD=XM : YOLD=YM : PASS=1
  2104. END IF
  2105. '
  2106. '  Look for cursor motion and update CMOT.
  2107. '
  2108. INREGS.AX=&HB
  2109. CALL INTERRUPTX(&H33,INREGS,OUTREGS)
  2110. CMOT=ABS(OUTREGS.CX)+ABS(OUTREGS.DX)
  2111. '
  2112. '  If cursor moved, restore box background in preparation for redrawing
  2113. ' it.  Whether or not cursor moved, if button was released, restore box
  2114. ' background in preparation for exiting routine.
  2115. '
  2116. IF CMOT<>0 OR RELEASE=1 THEN
  2117. K=1
  2118. XSTEP=1 : IF XOLD<CINT(XP) THEN XSTEP=-XSTEP
  2119. YSTEP=1 : IF YOLD<CINT(YP) THEN YSTEP=-YSTEP
  2120. FOR I=CINT(YP) TO YOLD STEP YSTEP
  2121. INREGS.AX=3072+ASC(BOXBAK(K))
  2122. INREGS.BX=VPAGE
  2123. INREGS.CX=CINT(XP)
  2124. INREGS.DX=I
  2125. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2126. K=K+1
  2127. NEXT I
  2128. FOR I=CINT(XP)+XSTEP TO XOLD STEP XSTEP
  2129. INREGS.AX=3072+ASC(BOXBAK(K))
  2130. INREGS.BX=VPAGE
  2131. INREGS.CX=I
  2132. INREGS.DX=YOLD
  2133. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2134. K=K+1
  2135. NEXT I
  2136. FOR I=YOLD-YSTEP TO CINT(YP) STEP -YSTEP
  2137. INREGS.AX=3072+ASC(BOXBAK(K))
  2138. INREGS.BX=VPAGE
  2139. INREGS.CX=XOLD
  2140. INREGS.DX=I
  2141. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2142. K=K+1
  2143. NEXT I
  2144. FOR I=XOLD-XSTEP TO CINT(XP)+XSTEP STEP -XSTEP
  2145. INREGS.AX=3072+ASC(BOXBAK(K))
  2146. INREGS.BX=VPAGE
  2147. INREGS.CX=I
  2148. INREGS.DX=CINT(YP)
  2149. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2150. K=K+1
  2151. NEXT I
  2152. END IF
  2153. IF RELEASE=0 THEN GOTO GETRELEASE
  2154. '
  2155. '  Output results.
  2156. '
  2157. XR=CSNG(XM) : YR=CSNG(YM)
  2158. END SUB
  2159. '
  2160. '  This subroutine is a lot like MGET.  However, rather than transfer
  2161. ' the pixel data to an array, it prints it to an HP Laserjet/Deskjet
  2162. ' printer.  Similar to MGET, (XL,YL) are the viewport/screen coordinates
  2163. ' of upper lefthand corner of the rectangular region on the screen to be
  2164. ' printed and (XR,YR) are the coordinates of the lower righthand corner.
  2165. ' DPI is the dots/inch that you want to print at.  FF should be input as
  2166. ' 1! (or 1.) if you want to form feed when you're done printing.  (Any
  2167. ' other value means "no form feed.")  Since this subroutine uses the
  2168. ' LPRINT command, the I/O port is assumed to be LPT1.
  2169. '
  2170. SUB HPRINT(XL,YL,XR,YR,DPI,FF)
  2171. DIM VPAGE AS INTEGER
  2172. '
  2173. '  Presumably, you want to print something on the screen you're looking
  2174. ' at, not on some other page stored somewhere in memory.  Get visible
  2175. ' page and leave it as stored in BH.
  2176. '
  2177. INREGS.AX=&HF00
  2178. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2179. VPAGE=OUTREGS.BX
  2180. '
  2181. '  Take into account graphics viewport and make sure rectangular screen
  2182. ' area is defined correctly.
  2183. '
  2184. XMIN=VXL+XL : XMAX=VXL+XR : YMIN=VYL+YL : YMAX=VYL+YR
  2185. IF XMIN>XMAX THEN SWAP XMIN,XMAX
  2186. IF YMIN>YMAX THEN SWAP YMIN,YMAX
  2187. '
  2188. '  Get width of screen area.
  2189. '
  2190. W=INT(XMAX-XMIN)+1
  2191. '
  2192. '  Get number of whole bytes in each line and excess number of bits that
  2193. ' must be padded with zeros to make a complete byte.
  2194. '
  2195. W8=8*INT(W/8+.001)
  2196. PEX=W-W8
  2197. '
  2198. '  Set up printer.
  2199. '
  2200. WIDTH "LPT1:",255
  2201. LPRINT CHR$(27);"&l0O";
  2202. LPRINT CHR$(27);"*t";LTRIM$(RTRIM$(STR$(DPI)));"R";
  2203. BYTES=W8/8+SGN(PEX)
  2204. FOR J=YMIN TO YMAX
  2205. '
  2206. '  Convert 8 bits at a time in line J to bytes and print each byte.
  2207. ' (All that matters here is whether the attribute of the pixel is 0 or
  2208. ' some color.  Any color but 0 is treated as a bit of one.)
  2209. '
  2210. '  First, start raster graphics and tell printer how many bytes are coming
  2211. ' for Jth line of pixels.
  2212. '
  2213. LPRINT CHR$(27);"*r0A";CHR$(27);"*b";LTRIM$(RTRIM$(STR$(BYTES)));"W";
  2214. '
  2215. '  Watch out for there being less than 8 columns of pixels to print.
  2216. '
  2217. IF W8>0 THEN
  2218. FOR I=XMIN TO XMIN+W8-1 STEP 8
  2219. V=0
  2220. FOR K=1 TO 8
  2221. INREGS.AX=&HD00
  2222. INREGS.BX=VPAGE
  2223. INREGS.CX=CINT(I+K-1)
  2224. INREGS.DX=CINT(J)
  2225. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2226. V=V+SGN(OUTREGS.AX AND &HFF)*2^(8-K)
  2227. NEXT K
  2228. '
  2229. '  Print byte.
  2230. '
  2231. LPRINT CHR$(V);
  2232. NEXT I
  2233. END IF
  2234. '
  2235. '  Print "excess byte" in row J.
  2236. '
  2237. IF PEX>0 THEN
  2238. V=0
  2239. FOR I=1 TO PEX
  2240. INREGS.AX=&HD00
  2241. INREGS.BX=VPAGE
  2242. INREGS.CX=CINT(XMIN+I+W8-1)
  2243. INREGS.DX=CINT(J)
  2244. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2245. V=V+SGN(OUTREGS.AX AND &HFF)*2^(8-I)
  2246. NEXT I
  2247. LPRINT CHR$(V);
  2248. END IF
  2249. '
  2250. '  End graphics transfer for current row of pixels.
  2251. '
  2252. LPRINT CHR$(27);"*rbC";
  2253. NEXT J
  2254. '
  2255. '  Graphics data is transferred.  Form feed printer if FF = 1.
  2256. '
  2257. IF FF=1 THEN LPRINT CHR$(12);
  2258. END SUB
  2259. '
  2260. '  This subroutine prints the portion of a graphics screen within the
  2261. ' rectangle specified by (XL,YL) and (XR,YR) on a 24-pin Epson LQ
  2262. ' printer.  Like HPRINT, FF is input as 1! to form feed when finished.
  2263. '
  2264. SUB EPRINT(XL,YL,XR,YR,FF)
  2265. DIM VPAGE AS INTEGER
  2266. '
  2267. '  Presumably, you want to print something on the screen you're looking
  2268. ' at, not on some other page stored somewhere in memory.  Get visible
  2269. ' page and leave it as stored in BH.
  2270. '
  2271. INREGS.AX=&HF00
  2272. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2273. VPAGE=OUTREGS.BX
  2274. '
  2275. '  Take into account graphics viewport and make sure rectangular screen
  2276. ' area is defined correctly.
  2277. '
  2278. XMIN=VXL+XL : XMAX=VXL+XR : YMIN=VYL+YL : YMAX=VYL+YR
  2279. IF XMIN>XMAX THEN SWAP XMIN,XMAX
  2280. IF YMIN>YMAX THEN SWAP YMIN,YMAX
  2281. '
  2282. '  Get width and height of screen area.
  2283. '
  2284. W=INT(XMAX-XMIN)+1  : H=INT(YMAX-YMIN)+1
  2285. '
  2286. '  Being a typical dot matrix printer, the Epson LQ prints a column of
  2287. ' dots as the printhead moves horizontally across the page.  In this
  2288. ' particular case, there are 24 dots in that column.  Find the number
  2289. ' of lines in the picture area that is an integral multiple of 24.  The
  2290. ' bits for the excess lines must be padded with zeros to make a complete
  2291. ' set of 24.
  2292. '
  2293. H24=24*INT(H/24+.001)
  2294. LEX=H-H24
  2295. '
  2296. '  Set up printer.
  2297. '
  2298. WIDTH "LPT1:",255
  2299. '
  2300. '  N1 and N2 are the low and high bytes of width W.
  2301. '
  2302. N2=INT(W/256+.001)
  2303. N1=W-256*N2
  2304. LPRINT CHR$(27);"3";CHR$(24);
  2305. '
  2306. '  Watch out for there being less than 24 lines of pixels to print.
  2307. '
  2308. IF H24>0 THEN
  2309. FOR J=YMIN TO YMIN+H24-1 STEP 24
  2310. '
  2311. '  Get three bytes corresponding to each column of 24 pixels in pixel
  2312. ' rows J to J + 23.  (All that matters here is whether the attribute of
  2313. ' the pixel is 0 or some color.  Any color but 0 is treated as a bit of
  2314. ' one.)
  2315. '
  2316. '  First, tell printer how many bits are coming for each row of pixels.
  2317. '
  2318. LPRINT CHR$(27);"*";CHR$(39);CHR$(N1);CHR$(N2);
  2319. FOR I=XMIN TO XMAX
  2320. V1=0
  2321. V2=0
  2322. V3=0
  2323. FOR K=1 TO 8
  2324. INREGS.AX=&HD00
  2325. INREGS.BX=VPAGE
  2326. INREGS.CX=CINT(I)
  2327. INREGS.DX=CINT(J+K-1)
  2328. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2329. V1=V1+SGN(OUTREGS.AX AND &HFF)*2^(8-K)
  2330. INREGS.AX=&HD00
  2331. INREGS.BX=VPAGE
  2332. INREGS.CX=CINT(I)
  2333. INREGS.DX=CINT(J+K+7)
  2334. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2335. V2=V2+SGN(OUTREGS.AX AND &HFF)*2^(8-K)
  2336. INREGS.AX=&HD00
  2337. INREGS.BX=VPAGE
  2338. INREGS.CX=CINT(I)
  2339. INREGS.DX=CINT(J+K+15)
  2340. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2341. V3=V3+SGN(OUTREGS.AX AND &HFF)*2^(8-K)
  2342. NEXT K
  2343. '
  2344. '  Print 3 bytes.
  2345. '
  2346. LPRINT CHR$(V1);CHR$(V2);CHR$(V3);
  2347. NEXT I
  2348. '
  2349. '  Reset starting print position.
  2350. '
  2351. LPRINT
  2352. NEXT J
  2353. END IF
  2354. '
  2355. '  Print excess lines of pixels.
  2356. '
  2357. IF LEX>0 THEN
  2358. LPRINT CHR$(27);"*";CHR$(39);CHR$(N1);CHR$(N2);
  2359. FOR I=XMIN TO XMAX
  2360. V1=0
  2361. V2=0
  2362. V3=0
  2363. FOR J=1 TO 8
  2364. IF J<=LEX THEN
  2365. INREGS.AX=&HD00
  2366. INREGS.BX=VPAGE
  2367. INREGS.CX=CINT(I)
  2368. INREGS.DX=CINT(YMIN+J+H24-1)
  2369. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2370. V1=V1+SGN(OUTREGS.AX AND &HFF)*2^(8-J)
  2371. END IF
  2372. IF J+8<=LEX THEN
  2373. INREGS.AX=&HD00
  2374. INREGS.BX=VPAGE
  2375. INREGS.CX=CINT(I)
  2376. INREGS.DX=CINT(YMIN+J+H24+7)
  2377. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2378. V2=V2+SGN(OUTREGS.AX AND &HFF)*2^(8-J)
  2379. END IF
  2380. IF J+16<=LEX THEN
  2381. INREGS.AX=&HD00
  2382. INREGS.BX=VPAGE
  2383. INREGS.CX=CINT(I)
  2384. INREGS.DX=CINT(YMIN+J+H24+15)
  2385. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2386. V3=V3+SGN(OUTREGS.AX AND &HFF)*2^(8-J)
  2387. END IF
  2388. NEXT J
  2389. LPRINT CHR$(V1);CHR$(V2);CHR$(V3);
  2390. NEXT I
  2391. LPRINT
  2392. END IF
  2393. '
  2394. '  Graphics data is transferred.  Reset printer line spacing.
  2395. '
  2396. LPRINT CHR$(27);"2";
  2397. '
  2398. '  Form feed printer if FF = 1.
  2399. '
  2400. IF FF=1 THEN LPRINT CHR$(12);
  2401. END SUB
  2402. '
  2403. '  This subroutine prints the portion of a graphics screen within the
  2404. ' rectangle specified by (XL,YL) and (XR,YR) using "standard" 8-pin
  2405. ' graphics commands.  It should work with 9-pin printers such as Epsons,
  2406. ' the Panasonic KX-P1092, the Star SG-10 or 15, etc.  (It should also
  2407. ' work with the Epson LQ, if 8-pin graphics are acceptable.)  Like HPRINT
  2408. ' and EPRINT, FF is input as 1! to form feed when finished.  The character
  2409. ' string PTYPE$ should be input as "S" if your printer is set up in its
  2410. ' standard or native mode and "I" if it's set up to emulate IBM graphics.
  2411. '
  2412. SUB PRINT8(XL,YL,XR,YR,FF,PTYPE$)
  2413. DIM VPAGE AS INTEGER
  2414. '
  2415. '  Presumably, you want to print something on the screen you're looking
  2416. ' at, not on some other page stored somewhere in memory.  Get visible
  2417. ' page and leave it as stored in BH.
  2418. '
  2419. INREGS.AX=&HF00
  2420. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2421. VPAGE=OUTREGS.BX
  2422. '
  2423. '  Take into account graphics viewport and make sure rectangular screen
  2424. ' area is defined correctly.
  2425. '
  2426. XMIN=VXL+XL : XMAX=VXL+XR : YMIN=VYL+YL : YMAX=VYL+YR
  2427. IF XMIN>XMAX THEN SWAP XMIN,XMAX
  2428. IF YMIN>YMAX THEN SWAP YMIN,YMAX
  2429. '
  2430. '  Get width and height of screen area.
  2431. '
  2432. W=INT(XMAX-XMIN)+1  : H=INT(YMAX-YMIN)+1
  2433. '
  2434. '  Data is sent to the printer one column of 8 dots at a time.  Find the
  2435. ' number of lines in the picture area that is an integral multiple of 8.
  2436. ' The bits for the excess lines must be padded with zeros to make a
  2437. ' complete set of 8.
  2438. '
  2439. H8=8*INT(H/8+.001)
  2440. LEX=H-H8
  2441. '
  2442. '  Set up printer.
  2443. '
  2444. WIDTH "LPT1:",255
  2445. '
  2446. '  N1 and N2 are the low and high bytes of width W.
  2447. '
  2448. N2=INT(W/256+.001)
  2449. N1=W-256*N2
  2450. LPRINT CHR$(27);"A";CHR$(8);
  2451. IF UCASE$(PTYPE$)="I" THEN LPRINT CHR$(27);"2";
  2452. '
  2453. '  Watch out for there being less than 8 lines of pixels to print.
  2454. '
  2455. IF H8>0 THEN
  2456. FOR J=YMIN TO YMIN+H8-1 STEP 8
  2457. '
  2458. '  Get byte corresponding to each column of 8 pixels in pixel rows J to
  2459. ' J + 7.  (All that matters here is whether the attribute of the pixel is
  2460. ' 0 or some color.  Any color but 0 is treated as a bit of one.)
  2461. '
  2462. '  First, tell printer how many bits are coming for each row of pixels.
  2463. '
  2464. LPRINT CHR$(27);"L";CHR$(N1);CHR$(N2);
  2465. FOR I=XMIN TO XMAX
  2466. V=0
  2467. FOR K=1 TO 8
  2468. INREGS.AX=&HD00
  2469. INREGS.BX=VPAGE
  2470. INREGS.CX=CINT(I)
  2471. INREGS.DX=CINT(J+K-1)
  2472. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2473. V=V+SGN(OUTREGS.AX AND &HFF)*2^(8-K)
  2474. NEXT K
  2475. '
  2476. '  Print byte.
  2477. '
  2478. LPRINT CHR$(V);
  2479. NEXT I
  2480. '
  2481. '  Reset starting print position.
  2482. '
  2483. LPRINT
  2484. NEXT J
  2485. END IF
  2486. '
  2487. '  Print excess lines of pixels.
  2488. '
  2489. IF LEX>0 THEN
  2490. LPRINT CHR$(27);"L";CHR$(N1);CHR$(N2);
  2491. FOR I=XMIN TO XMAX
  2492. V=0
  2493. FOR J=1 TO LEX
  2494. INREGS.AX=&HD00
  2495. INREGS.BX=VPAGE
  2496. INREGS.CX=CINT(I)
  2497. INREGS.DX=CINT(YMIN+J+H8-1)
  2498. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  2499. V=V+SGN(OUTREGS.AX AND &HFF)*2^(8-J)
  2500. NEXT J
  2501. LPRINT CHR$(V);
  2502. NEXT I
  2503. LPRINT
  2504. END IF
  2505. '
  2506. '  Graphics data is transferred.  Reset printer line spacing.
  2507. '
  2508. IF UCASE$(PTYPE$)="I" THEN LPRINT CHR$(27);"A";CHR$(12);
  2509. LPRINT CHR$(27);"2";
  2510. '
  2511. '  Form feed printer if FF = 1.
  2512. '
  2513. IF FF=1 THEN LPRINT CHR$(12);
  2514. END SUB
  2515.